section\<open>Supplementary results related to intermediate lemmas used in the proof of the
 Balog--Szemer\'{e}di--Gowers Theorem\<close>

(*
  Session: Balog_Szemeredi_Gowers
  Title: Balog_Szemeredi_Gowers_Supplementary.thy
  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds
  Affiliation: University of Cambridge
  Date: August 2022.
*)

theory Balog_Szemeredi_Gowers_Supplementary
  imports
    Balog_Szemeredi_Gowers_Main_Proof
begin

context additive_abelian_group

begin

text\<open>Even though it is not applied anywhere in this development, for the sake of completeness we give
the following analogous version of Lemma 2.17 (@{term popular_differences_card}) but for popular sums
instead of popular differences. The proof is identical to that of Lemma 2.17, with the obvious
modifications.\<close>

lemma popular_sums_card:
  fixes A::"'a set" and c::real
  assumes "finite A" and "additive_energy A = 2 * c" and "A \<subseteq> G"
  shows "card (popular_sum_set c A) \<ge> c * card A"

proof(cases "card A \<noteq> 0")
  assume hA: "card A \<noteq> 0"
  have hc: "c \<ge> 0" using assms additive_energy_def of_nat_0_le_iff
    by (smt (verit, best) assms(3) divide_nonneg_nonneg of_nat_0_le_iff)
  have "(2 * c) * (card A)^3 = (\<Sum>d \<in> (sumset A A). (f_sum d A)^2)"
    using assms f_sum_card_quadruple_set_additive_energy by auto
  also have "...= ((\<Sum>d \<in> (popular_sum_set c A). (f_sum d A)^2))
    +((\<Sum> d \<in> ((sumset A A) - (popular_sum_set c A)). (f_sum d A)^2))"
    using popular_sum_set_def assms finite_sumset by (metis (no_types, lifting)
      add.commute mem_Collect_eq subsetI sum.subset_diff)
  also have "... \<le> ((card (popular_sum_set c A)) * (card A)^2)
    + c * card A * ((\<Sum>d \<in> (sumset A A - (popular_sum_set c A)) . (f_sum d A)))"
  proof-
    have "\<forall> d \<in> ((sumset A A) - (popular_sum_set c A)) . (f_sum d A)^2 \<le>
      (c * (card A)) * (f_sum d A)"
    proof
     fix d assume hd1: "d \<in> sumset A A - popular_sum_set c A"
     have hnonneg: "f_sum d A \<ge> 0" by auto
     have "\<not> popular_sum d c A" using hd1 popular_sum_set_def by blast
     from this have "f_sum d A \<le> c * card A" using popular_sum_def by auto
     thus "real ((f_sum d A)\<^sup>2) \<le> c * real (card A) * real (f_sum d A)"
       using power2_eq_square hnonneg mult_right_mono of_nat_0 of_nat_le_iff of_nat_mult by metis
   qed
   moreover have "\<forall> d \<in> (sumset A A) . f_sum d A \<le> (card A)^2"
     using f_sum_def finite_sumset assms
     by (metis f_sum_le_card le_antisym nat_le_linear power2_nat_le_imp_le)
   ultimately have "((\<Sum>d \<in> ((sumset A A) - popular_sum_set c A) . (f_sum d A)^2)) \<le>
     ((\<Sum>d \<in> ((sumset A A) - popular_sum_set c A). (c * card A) * (f_sum d A)))"
     using assms finite_sumset sum_distrib_left sum_mono by fastforce
   then have "((\<Sum>d \<in> ((sumset A A) - popular_sum_set c A) . (f_sum d A)^2)) \<le>
     (c * card A) * ((\<Sum>d \<in> ((sumset A A) - popular_sum_set c A) . (f_sum d A)))"
     by (metis (no_types) of_nat_sum sum_distrib_left)
   moreover have "(\<Sum>d \<in> popular_sum_set c A. (f_sum d A)^2) \<le>
    (\<Sum>d \<in> popular_sum_set c A. (card A)^2)" using f_sum_le_card assms sum_mono assms popular_sum_set_def
     by (metis (no_types, lifting) power2_nat_le_eq_le)
   moreover then have "(\<Sum>d \<in> popular_sum_set c A . (f_sum d A)^2) \<le>
    (card (popular_sum_set c A)) * (card A)^2"
    using sum_distrib_right by simp
    ultimately show ?thesis by linarith
  qed
  also have "...  \<le> ((card (popular_sum_set c A)) * (card A)^2) + (c * card A) * (card A)^2"
  proof-
    have "(\<Sum>d \<in> (sumset A A - popular_sum_set c A) . (f_sum d A)) \<le>
      (\<Sum>d \<in> sumset A A . (f_sum d A))" using DiffD1 subsetI assms sum_mono2
      finite_sumset zero_le by metis
    then have "(c * card A) * ((\<Sum>d \<in> (sumset A A - popular_sum_set c A). (f_sum d A)))
      \<le> (c * card A) * (card A)^2"
      using f_sum_card hc le0 mult_left_mono of_nat_0 of_nat_mono zero_le_mult_iff assms by metis
    then show ?thesis by linarith
  qed
  finally have "(2 * c) * (card A)^3  \<le> ((card (popular_sum_set c A)) * (card A)^2) +
    (c * card A) * (card A)^2" by linarith
  then have "(card (popular_sum_set c A)) \<ge>
    ((2 * c)* (card A)^3 - (c * card A) * (card A)^2)/((card A)^2)"
    using hA by (simp add: field_simps)
  moreover have "((2 * c)* (card A)^3 - (c * card A) * (card A)^2)/((card A)^2) = 2 * c * card A - c * card A"
    using hA by (simp add: power2_eq_square power3_eq_cube)
  ultimately show ?thesis by linarith
next
  assume "\<not> card A \<noteq> 0"
  thus ?thesis by auto
qed

text\<open>The following is an analogous version of lemma @{term obtains_subsets_differenceset_card_bound}
(2.18 in Gowers's notes \cite{Gowersnotes}) but for a sumset instead of a difference set. It is not used anywhere in this
development but we provide it for the sake of completeness. The proof is identical to that of
lemma @{term obtains_subsets_differenceset_card_bound} with @{term f_diff} changed to @{term f_sum},
@{term popular_diff} changed to @{term popular_sum}, \oplus interchanged with \ominus, and instead of
lemma @{term popular_differences_card} we apply its analogous version for popular sums, that is
lemma @{term popular_sums_card}. \<close>

lemma obtains_subsets_sumset_card_bound: fixes A::"'a set" and c::real
  assumes "finite A"  and "c>0"  and "A \<noteq> {}" and "A \<subseteq> G" and "additive_energy A = 2 * c"
  obtains B and A' where "B \<subseteq> A" and "B \<noteq> {}" and "card B \<ge> c^4 * card A / 16"
  and "A' \<subseteq> A" and "A' \<noteq> {}" and "card A' \<ge> c^2 * card A / 4"
  and "card (sumset A' B) \<le> 2^13 * card A / c^15"

proof-
  let ?X = "A \<times> {0:: nat}"
  let ?Y = "A \<times> {1:: nat}"
  let ?E = "mk_edge ` {(x, y)| x y. x \<in> ?X \<and> y \<in> ?Y \<and> (popular_sum (fst y \<oplus> fst x) c A)}"
  interpret H: fin_bipartite_graph "?X \<union> ?Y" ?E ?X ?Y
  proof (unfold_locales, auto simp add: partition_on_def assms(3) assms(1) disjoint_def)
    show "{} = A \<times> {0} \<Longrightarrow> False" using assms(3) by auto
  next
    show "{} = A \<times> {Suc 0} \<Longrightarrow> False" using assms(3) by auto
  next
    show "A \<times> {0} = A \<times> {Suc 0} \<Longrightarrow> False" using assms(3) by fastforce
  next
    fix x y assume "x \<in> A" and "y \<in> A" and "popular_sum (y \<oplus> x) c A"
    thus "{(x, 0), (y, Suc 0)} \<in> all_bi_edges (A \<times> {0}) (A \<times> {Suc 0})"
      using all_bi_edges_def[of "A \<times> {0}" "A \<times> {Suc 0}"]
      by (simp add: in_mk_edge_img)
  qed
  have edges1: "\<forall> a \<in> A. \<forall> b \<in> A. ({(a, 0), (b, 1)} \<in> ?E \<longleftrightarrow> popular_sum (b \<oplus> a) c A)"
    by (auto simp add: in_mk_uedge_img_iff)
  have hXA: "card A = card ?X" by (simp add: card_cartesian_product)
  have hYA: "card A = card ?Y" by (simp add: card_cartesian_product)
  have hA: "card A \<noteq> 0" using assms card_0_eq by blast
  have edge_density: "H.edge_density ?X ?Y \<ge> c^2"
  proof-
    define f:: "'a \<Rightarrow> ('a \<times> nat) edge set" where "f \<equiv> (\<lambda> x. {{(a, 0), (b, 1)} | a b.
      a \<in> A \<and> b \<in> A \<and> b \<oplus> a = x})"
    have f_disj: "pairwise (\<lambda> s t. disjnt (f s) (f t)) (popular_sum_set c A)"
    proof (intro pairwiseI)
      fix x y assume hx: "x \<in> popular_sum_set c A" and hy: "y \<in> popular_sum_set c A"
        and hxy: "x \<noteq> y"
      show "disjnt (f x) (f y)"
      proof-
        have "\<forall>a. \<not> (a \<in> f x \<and> a \<in> f y)"
        proof (intro allI notI)
          fix a assume "a \<in> f x \<and> a \<in> f y"
          then obtain z w where hazw: "a = {(z, 0), (w, 1)}" and hx: "{(z,0), (w, 1)} \<in> f x"
            and hy: "{(z, 0), (w, 1)} \<in> f y" using f_def by blast
          have "w \<oplus> z = x" using f_def hx by (simp add: doubleton_eq_iff)
          moreover have "w \<oplus> z = y" using f_def hy by (simp add: doubleton_eq_iff)
          ultimately show "False" using hxy by auto
        qed
        thus ?thesis using disjnt_iff by auto
      qed
    qed
    have f_sub_edges: "\<forall> d \<in> popular_sum_set c A. (f d) \<subseteq> ?E"
      using popular_sum_set_def f_def edges1 by auto
    have f_union_sub: "(\<Union> d \<in> popular_sum_set c A. (f d)) \<subseteq> ?E" using popular_sum_set_def
      f_def edges1 by auto
    have f_disj2: "disjoint (f ` (popular_sum_set c A))" using f_disj
      pairwise_image[of "disjnt" "f" "popular_sum_set c A"] by (simp add: pairwise_def)
    have f_finite: "\<And>B. B \<in> f ` popular_sum_set c A \<Longrightarrow> finite B"
      using finite_subset f_sub_edges H.fin_edges by auto
    have card_eq_f_diff: "\<forall> d \<in> popular_sum_set c A. card (f d) = f_sum d A"
    proof
      fix d assume "d \<in> popular_sum_set c A"
      define g:: "('a \<times> 'a) \<Rightarrow> ('a \<times> nat) edge" where "g = (\<lambda> (a, b). {(b, 0), (a, 1)})"
      have g_inj: "inj_on g {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}"
      proof (intro inj_onI)
        fix x y assume "x \<in> {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}" and
          "y \<in> {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}" and hg: "g x = g y"
        then obtain a1 a2 b1 b2  where hx: "x = (a1, a2)" and hy: "y = (b1, b2)"  by blast
        thus "x = y" using g_def hg hx hy by (simp add: doubleton_eq_iff)
      qed
      have g_image: "g ` {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d} = f d" using f_def g_def by auto
      show "card (f d) = f_sum d A" using card_image g_inj g_image f_sum_def by fastforce
    qed
    have "c ^ 2 * (card A) ^ 2 = c * (card A) * (c * (card A))" using power2_eq_square
      by (metis of_nat_power power_mult_distrib)
    also have "... \<le> (card (popular_sum_set c A)) * (c * (card A))"
      using assms  popular_sums_card hA by force
    also have "... \<le> (\<Sum> d \<in> popular_sum_set c A. f_sum d A)" using sum_mono popular_sum_set_def
      popular_sum_def by (smt (verit, ccfv_SIG) mem_Collect_eq of_nat_sum of_real_of_nat_eq
      sum_constant)
    also have "... = (\<Sum> d \<in> popular_sum_set c A. card (f d))"
      using card_eq_f_diff sum.cong by auto
    also have "... = sum card (f ` (popular_sum_set c A))"
      using f_disj sum_card_image[of "popular_sum_set c A" "f"] popular_sum_set_def
        finite_sumset assms(1) finite_subset by auto
    also have "... = card (\<Union> d \<in> popular_sum_set c A. (f d))"
      using card_Union_disjoint[of "f ` (popular_sum_set c A)"] f_disj2 f_finite by auto
    also have "... \<le> card ?E" using card_mono f_union_sub H.fin_edges by auto
    finally have "c ^ 2 * (card A) ^ 2 \<le> card ?E" by linarith
    then have "c ^ 2 * (card A) ^ 2 \<le> card (H.all_edges_between ?X ?Y)"
      using H.card_edges_between_set by auto
    moreover have "H.edge_density ?X ?Y = card (H.all_edges_between ?X ?Y) / (card A) ^ 2"
      using  H.edge_density_def power2_eq_square hXA hYA
      by (smt (verit, best))
    ultimately have "(c ^ 2 * (card A) ^ 2) / (card A) ^ 2 \<le> H.edge_density ?X ?Y" using hA
      divide_le_cancel by (smt (verit, del_insts) H.edge_density_ge0 \<open>c\<^sup>2 * real ((card A)\<^sup>2) =
        c * real (card A) * (c * real (card A))\<close> divide_divide_eq_right zero_le_divide_iff)
    thus ?thesis using hA assms(2) by auto
  qed
  obtain X' and Y' where X'sub: "X' \<subseteq> ?X" and Y'sub: "Y' \<subseteq> ?Y" and
    hX': "card X' \<ge> (H.edge_density ?X ?Y)^2 * (card ?X)/16" and
    hY': "card Y' \<ge> (H.edge_density ?X ?Y) * (card ?Y)/4" and
    hwalks: "\<forall>  x \<in> X'. \<forall> y \<in> Y'. card ({p. H.connecting_walk x y p \<and> H.walk_length p = 3}) \<ge>
    (H.edge_density ?X ?Y)^6 * card ?X * card ?Y / 2^13"
    using H.walks_of_length_3_subsets_bipartite \<open>c>0\<close> by auto
  have "((c^2)^2) * (card A) \<le> (H.edge_density ?X ?Y)^2 * (card A)"
    using edge_density assms(2) hA power_mono zero_le_power2 mult_le_cancel_right
    by (smt (verit) of_nat_less_of_nat_power_cancel_iff of_nat_zero_less_power_iff
      power2_less_eq_zero_iff power_0_left)
  then have cardX': "card X' \<ge> (c^4) * (card A)/16" using hX' divide_le_cancel hXA by fastforce
  have "c^2 * (card A) / 4 \<le> (H.edge_density ?X ?Y) * card ?Y / 4" using hYA hA edge_density
      mult_le_cancel_right by simp
  then have cardY': "card Y' \<ge> c^2 * (card A)/4" using hY' by linarith
  have "(H.edge_density ?X ?Y)^6 * (card ?X * card ?Y)/ 2^13 \<ge> (c^2)^6 * ((card A)^2) / 2^13" using
  hXA hYA power2_eq_square edge_density divide_le_cancel mult_le_cancel_right hA
    by (smt (verit, ccfv_SIG) of_nat_power power2_less_0 power_less_imp_less_base zero_le_power)
  then have card_walks: "\<forall> x \<in> X'. \<forall> y \<in> Y'.
    card ({p. H.connecting_walk x y p \<and> H.walk_length p = 3}) \<ge> (c^12) * ((card A)^2) / 2^13"
    using hwalks by fastforce
  (* ?X and ?Y are subsets of the vertex set, now project down to G, giving subsets ?B and ?C of A,
  respectively*)
  let ?B = "(\<lambda> (a, b). a) ` X'"
  let ?C = "(\<lambda> (a, b). a) ` Y'"
  have hBA: "?B \<subseteq> A" and hCA: "?C \<subseteq> A" using Y'sub X'sub by auto
  have inj_on_X': "inj_on (\<lambda> (a, b). a) X'" using X'sub by (intro inj_onI) (auto)
  have inj_on_Y': "inj_on (\<lambda> (a, b). a) Y'" using Y'sub by (intro inj_onI) (auto)
  have hBX': "card ?B = card X'" and hCY': "card ?C = card Y'"
    using card_image inj_on_X' inj_on_Y' by auto
  then have cardB: "card ?B \<ge> (c^4) * (card A)/16" and cardC: "card ?C \<ge> c^2 * (card A)/4"
    using cardX' cardY' by auto
  have card_ineq1: "\<And> x y. x \<in> ?B \<Longrightarrow> y \<in> ?C \<Longrightarrow> card ({(z, w) | z w. z \<in> A \<and> w \<in> A \<and>
  popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}) \<ge>
  (c^12) * ((card A)^2) / 2^13"
  proof-
    fix x y assume hx: "x \<in> ?B" and hy: "y \<in> ?C"
    have hxA: "x \<in> A" and hyA: "y \<in> A" using hx hy hBA hCA by auto
    define f:: "'a \<times> 'a \<Rightarrow> ('a \<times> nat) list"
      where "f \<equiv> (\<lambda> (z, w). [(x, 0), (z, 1), (w, 0), (y, 1)])"
    have f_inj_on: "inj_on f {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" using f_def by (intro inj_onI) (auto)
    have f_image: "f ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} =
      {p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3}"
    proof
      show "f ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
        popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} \<subseteq>
        {p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3}"
      proof
        fix p assume hp: "p \<in> f ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
          popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}"
        then obtain z w where hz: "z \<in> A" and hw: "w \<in> A" and hzx: "popular_sum (z \<oplus> x) c A" and
          hzw: "popular_sum (z \<oplus> w) c A" and hyw: "popular_sum (y \<oplus> w) c A" and
          hp: "p = [(x, 0), (z, 1), (w, 0), (y, 1)]" using f_def hp by fast
        then have hcon: "H.connecting_walk (x, 0) (y, 1) p"
          unfolding H.connecting_walk_def H.is_walk_def
          using hxA hyA H.vert_adj_def H.vert_adj_sym edges1 by simp
        thus "p \<in> {p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3}"
            using hp H.walk_length_conv by auto
        qed
      next
        show "{p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3} \<subseteq> f ` {(z, w) |z w.
          z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
          popular_sum (y \<oplus> w) c A}"
        proof(intro subsetI)
          fix p assume hp: "p \<in> {p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3}"
          then have len: "length p = 4" using H.walk_length_conv by auto
          have hpsub: "set p \<subseteq> A \<times> {0} \<union> A \<times> {1}" using hp H.connecting_walk_def H.is_walk_def
            by auto
          then have fst_sub: "fst ` set p \<subseteq> A" by auto
          have h1A: "fst (p!1) \<in> A" and h2A: "fst (p!2) \<in> A" using fst_sub len by auto
          have hpnum: "p = [p!0, p!1, p!2, p!3]"
          proof (auto simp add:  list_eq_iff_nth_eq len)
            fix k assume "k < (4:: nat)"
            then have "k = 0 \<or> k = 1 \<or> k = 2 \<or> k = 3" by auto
            thus "p ! k = [p ! 0, p ! Suc 0, p ! 2, p ! 3] ! k" by fastforce
          qed
          then have "set (H.walk_edges p) = {{p!0, p!1} , {p!1, p!2}, {p!2, p!3}}" using
            comp_sgraph.walk_edges.simps(2) comp_sgraph.walk_edges.simps(3)
            by (metis empty_set list.simps(15))
          then have h1: "{p!0, p!1} \<in> ?E" and h2: "{p!2, p!1} \<in> ?E" and h3: "{p!2, p!3} \<in> ?E"
            using hp H.connecting_walk_def H.is_walk_def len by auto
          have hxp: "p!0 = (x, 0)" using hp len hd_conv_nth H.connecting_walk_def H.is_walk_def
            by fastforce
          have hyp: "p!3 = (y, 1)" using hp len last_conv_nth H.connecting_walk_def H.is_walk_def
            by fastforce
          have h1p: "p!1 = (fst (p!1), 1)"
          proof-
            have "p!1 \<in> A \<times> {0} \<union> A \<times> {1}" using hpnum hpsub
              by (metis (no_types, lifting) insertCI list.simps(15) subsetD)
            then have hsplit: "snd (p!1) = 0 \<or> snd (p!1) = 1" by auto
            then have "snd (p!1) = 1"
            proof(cases "snd (p!1) = 0")
              case True
              then have 1: "{(x, 0), (fst (p!1), 0)} \<in> ?E" using h1 hxp doubleton_eq_iff
                by (smt (verit, del_insts) surjective_pairing)
              have hY: "(fst (p!1), 0) \<notin> ?Y" and  hX: "(x, 0) \<in> ?X" using hxA by auto
              then have 2: "{(x, 0), (fst (p!1), 0)} \<notin> ?E" using H.X_vert_adj_Y H.vert_adj_def by meson
              then show ?thesis using 1 2 by blast
            next
              case False
              then show ?thesis using hsplit by auto
            qed
            thus "(p ! 1) = (fst (p ! 1), 1)"
              by (metis (full_types) split_pairs)
          qed
          have h2p: "p!2 = (fst (p!2), 0)"
          proof-
            have "p!2 \<in> A \<times> {0} \<union> A \<times> {1}" using hpnum hpsub
              by (metis (no_types, lifting) insertCI list.simps(15) subsetD)
            then have hsplit: "snd (p!2) = 0 \<or> snd (p!2) = 1" by auto
            then have "snd (p!2) = 0"
            proof(cases "snd (p!2) = 1")
              case True
              then have 1: "{(fst (p!2), 1), (y, 1)} \<in> ?E" using h3 hyp doubleton_eq_iff
                by (smt (verit, del_insts) surjective_pairing)
              have hY: "(y, 1) \<notin> ?X" and hX: "(fst (p!2), 1) \<in> ?Y" using hyA h2A by auto
              then have 2: "{(fst (p!2), 1), (y, 1)} \<notin> ?E" using H.Y_vert_adj_X H.vert_adj_def
                by meson
              then show ?thesis using 1 2 by blast
            next
              case False
              then show ?thesis using hsplit by auto
            qed
            thus "(p ! 2) = (fst (p ! 2), 0)"
              by (metis (full_types) split_pairs)
          qed
          have hpop1: "popular_sum ((fst (p!1)) \<oplus> x) c A" using edges1 h1 hxp h1p hxA h1A
            by (smt (z3))
          have hpop2: "popular_sum((fst (p!1)) \<oplus> (fst (p!2))) c A" using edges1 h2 h1p h2p h1A h2A
            by (smt (z3))
          have hpop3: "popular_sum (y \<oplus> (fst (p!2))) c A" using edges1 h3 h2p hyp hyA h2A
            by (smt (z3))
          thus "p \<in> f ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
            popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" using f_def hpnum hxp h1p h2p hyp
            h1A h2A hpop1 hpop2 hpop3 by force
        qed
      qed
      have hx1: "(x, 0) \<in> X'" and hy2: "(y, 1) \<in> Y'"  using hx X'sub hy Y'sub by auto
      have "card {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
        popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} =
        card {p. H.connecting_walk (x, 0) (y, 1) p \<and> H.walk_length p = 3}"
        using card_image f_inj_on f_image by fastforce
      thus "card {(z, w) |z w. z \<in> A \<and> w \<in> A \<and>  popular_sum (z \<oplus> x) c A \<and>
        popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} \<ge> c ^ 12 * ((card A)^2) / 2 ^ 13"
        using hx1 hy2 card_walks by auto
    qed
  have "\<And> x x2 y y2 z w . (x, x2) \<in> X'\<Longrightarrow> (y, y2) \<in> Y'\<Longrightarrow>  z \<in> A \<Longrightarrow> w \<in> A
    \<Longrightarrow> popular_sum (z \<oplus> x) c A \<Longrightarrow> popular_sum (z \<oplus> w) c A \<Longrightarrow> popular_sum (y \<oplus> w) c A \<Longrightarrow>
    c ^ 3 * real (card A) ^ 3 \<le>
    (card {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
    p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})"
  proof -
    fix x x2 y y2 z w assume "(x, x2) \<in> X'" and "(y, y2) \<in> Y'" and "z \<in> A" and "w \<in> A" and
      1: "popular_sum (z \<oplus> x) c A" and 2: "popular_sum (z \<oplus> w) c A" and
      3: "popular_sum (y \<oplus> w) c A"
    define f:: "'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a \<Rightarrow> ('a \<times> 'a) \<times> ('a \<times> 'a) \<times> ('a \<times> 'a)" where
      "f \<equiv> (\<lambda> (p, q, r, s, t, u). ((p, q), (r, s), (t, u)))"
    (* Types ('a \<times> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a) and  ('a \<times> 'a) \<times> ('a \<times> 'a) \<times> ('a \<times> 'a) are not
    definitionally equal, so we need to define a bijection between them *)
    have f_inj: "inj_on f {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
      t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}" using f_def
      by (intro inj_onI) (auto)
    have f_image: "f ` {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
      t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w} =
      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} \<times>
      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w} \<times>
      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = y \<oplus> w}" using f_def by force
    (* warning: this proof takes a while *)
    have 4: "card {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
      t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus>  w \<and> t \<oplus> u = y \<oplus> w} =
      card ({(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} \<times>
      {(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w} \<times> {(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = y \<oplus> w})"
      using card_image f_inj f_image by fastforce
    moreover have 5: "card ({(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} \<times>
      {(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w} \<times> {(p, q). p \<in> A \<and> q \<in> A \<and> p \<oplus> q = y \<oplus> w}) =
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} *
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w} *
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = y \<oplus> w}"
      using card_cartesian_product3 by auto
    have "c * card A \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x}"
      using 1 popular_sum_def f_sum_def by auto
    then have "(c * card A) * (c * card A) \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} *
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w}"
      using 2 popular_sum_def f_sum_def mult_mono assms(2) mult_nonneg_nonneg
        of_nat_0_le_iff of_nat_mult by fastforce
    then have 6: "(c * card A) * (c * card A) * (c * card A) \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> x} *
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = z \<oplus> w} *
      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<oplus> q = y \<oplus> w}"
      using 3 popular_sum_def f_sum_def mult_mono assms(2) mult_nonneg_nonneg of_nat_0_le_iff
      of_nat_mult by fastforce
    have 7: "c ^ 3 * card A ^ 3 = (c * card A) * ((c * card A) * (c * card A))"
      by (simp add: power3_eq_cube algebra_simps)
    show "c ^ 3 * real (card A) ^ 3 \<le>
      (card {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
      p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})" using 4 5 6 7 by auto
  qed
  then have card_ineq2: "\<And> x y z w. x \<in> ?B \<Longrightarrow> y \<in> ?C \<Longrightarrow> (z, w) \<in> {(z, w) | z w. z \<in> A \<and> w \<in> A \<and>
    popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} \<Longrightarrow>
    card {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
    p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w} \<ge> c^3 * card A^3"
    by auto
  have card_ineq3: "\<And> x y.  x \<in> ?B \<Longrightarrow> y \<in> ?C \<Longrightarrow> card (\<Union> (z, w) \<in> {(z, w) | z w. z \<in> A \<and> w \<in> A \<and>
    popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}.
    {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
    t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}) \<ge>
    c ^ 15 * ((card A)^5) / 2 ^ 13"
  proof-
    fix x y assume hx: "x \<in> ?B" and hy: "y \<in> ?C"
    have hxG: "x \<in> G" and hyG: "y \<in> G" using hx hy hBA hCA assms(4) by auto
    let ?f = "(\<lambda> (z, w). {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and>
      r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})"
    have hpair_disj: "pairwise (\<lambda> a b. disjnt (?f a) (?f b))
      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
      popular_sum (y \<oplus> w) c A}"
      proof (intro pairwiseI)
      fix a b assume "a \<in> {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
       popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" "b \<in> {(z, w) |z w. z \<in> A \<and> w \<in> A \<and>
       popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" and
       "a \<noteq> b"
      then obtain a1 a2 b1 b2 where ha: "a = (a1, a2)" and hb: "b = (b1, b2)" and ha1: "a1 \<in> G" and
        ha2: "a2 \<in> G" and hb1: "b1 \<in> G" and hb2: "b2 \<in> G" and hne: "(a1, a2) \<noteq> (b1, b2)"
        using assms(4) by blast
      have "(\<forall>x. \<not> (x \<in> (?f a) \<and> x \<in> (?f b)))"
      proof(intro allI notI)
        fix d assume "d \<in> (?f a) \<and> d \<in> (?f b)"
        then obtain p q r s t u where "d = (p, q, r, s, t, u)" and hpq1: "p \<oplus> q = a1 \<oplus> x" and
          htu1: "t \<oplus> u = y \<oplus> a2" and hpq2: "p \<oplus> q = b1 \<oplus> x" and htu2: "t \<oplus> u = y \<oplus> b2"
          using ha hb by auto
        then have "y \<oplus> a2 = y \<oplus> b2" using htu1 htu2 by auto
        then have 2: "a2 = b2" using ha2 hb2 hyG by (metis invertible invertible_left_cancel)
        have 1: "a1 = b1" using hpq1 hpq2 ha1 hb1 hxG by simp
        show "False" using 1 2 hne by auto
      qed
      thus "disjnt (?f a) (?f b)" using disjnt_iff[of "(?f a)" "(?f b)"] by auto
    qed
    have hfinite_walks: "\<And> B. B \<in> ((\<lambda> (z, w). {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and>  q \<in> A \<and>
      r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}) `
      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
      popular_sum (y \<oplus> w) c A}) \<Longrightarrow> finite B"
    proof-
      fix B assume "B \<in> ((\<lambda> (z, w). {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and>  q \<in> A \<and>
        r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}) `
        {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
        popular_sum (y \<oplus> w) c A})"
      then have "B \<subseteq> A \<times> A \<times> A \<times> A \<times> A \<times> A" by auto
      thus "finite B" using assms(1)
        by (auto simp add: finite_subset)
    qed
    have hdisj: "disjoint ((\<lambda> (z, w). {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and>  q \<in> A \<and>
      r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}) `
      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
      popular_sum (y \<oplus> w) c A})" using hpair_disj pairwise_image[of "disjnt" "(\<lambda> (z, w). {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and>  q \<in> A \<and>
      r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})"
      "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
      popular_sum (y \<oplus> w) c A}"] by (simp add: pairwise_def)
    have "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} \<subseteq> A \<times> A" by auto
    then have hwalks_finite: "finite {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" using finite_subset assms(1)
      by fastforce
    have f_ineq: "\<forall> a \<in> {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}. c ^ 3 * (card A) ^ 3 \<le>
      card (?f a)" using card_ineq2 hx hy by auto
    have "c ^ 15 * ((card A)^5) / 2 ^ 13 = (c ^ 12 * (card A) ^ 2 / 2 ^ 13) *  (c ^ 3 * card A ^ 3)"
      by (simp add: algebra_simps)
      also have "... \<le> card {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A} * (c ^ 3 * (card A) ^ 3)"
        using card_ineq1[of "x" "y"] hx hy mult_le_cancel_right hA by (smt (verit, best) assms(2)
        mult_pos_pos of_nat_0_less_iff of_nat_le_0_iff zero_less_power)
    also have "...  = (\<Sum> a \<in> {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}. (c ^ 3 * (card A) ^ 3))" by auto
    also have "... \<le> (\<Sum>a\<in>{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}. card (?f a))"
      using sum_mono f_ineq by (smt (verit, del_insts) of_nat_sum)
    also have "... = sum card (?f ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A})"
      using sum_card_image[of "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}" "?f"] hpair_disj hwalks_finite by auto
    also have "... = card (\<Union> (z, w)\<in>{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}. {(p, q, r, s, t, u) |p q r s t u.
      p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and>
      t \<oplus> u = y \<oplus> w})" using card_Union_disjoint hdisj hfinite_walks by (metis (no_types, lifting))
    finally show "c ^ 15 * real (card A ^ 5) / 2 ^ 13 \<le> real (card (\<Union>(z, w)\<in>{(z, w) |z w.
     z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and>
     popular_sum (y \<oplus> w) c A}. {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
     s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}))" by simp
  qed
  have pos: "0 < c ^ 15 * real (card A ^ 5) / 2 ^ 13" using hA \<open>c>0\<close> by auto
  have "(5:: nat) \<le> 6" by auto
  then have "(card A ^ 6 / card A ^ 5) = (card A) ^ (6 - 5)"
    using hA power_diff by (metis of_nat_eq_0_iff of_nat_power)
  then have cardApow: "(card A ^ 6 / card A ^ 5) = card A" using power_one_right by simp
  have hdsub: "\<forall> d \<in> sumset ?C ?B. \<exists> y \<in> ?C. \<exists> x \<in> ?B.
    (\<Union> (z, w) \<in> {(z, w) | z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
    popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}.
    {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
    t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})
    \<subseteq> {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
    s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
  proof
    fix d assume "d \<in> sumset ?C ?B"
    then obtain y x where hy: "y \<in> ?C" and hx: "x \<in> ?B" and hxy: "d = y \<oplus> x"
      using sumset_def minusset_def hBA hCA assms(4) subset_trans
      by (smt (verit, best) minusset.simps sumset.cases)
    have hxG: "x \<in> G" and hyG: "y \<in> G" using hx hy hBA hCA assms(4) by auto
    have "(\<Union>(z, w)\<in>{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}. {(p, q, r, s, t, u) |p q r s t u.
      p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})
      \<subseteq> {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
      d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
    proof (rule Union_least)
      fix X assume "X \<in> (\<lambda>(z, w). {(p, q, r, s, t, u) |p q r s t u.
      p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and>
      t \<oplus> u = y \<oplus> w}) ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
      popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}"
      then obtain z w where hX: "X = {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
        s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}"
        and hz: "z \<in> A" and hw: "w \<in> A" by auto
      have hzG: "z \<in> G" and hwG: "w \<in> G" using hz hw assms(4) by auto
      have "{(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
        s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w} \<subseteq>
        {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
        d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
      proof
        fix e assume "e \<in> {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
          t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}"
        then obtain p q r s t u where "p \<oplus> q = z \<oplus> x" and "r \<oplus> s = z \<oplus> w" and "t \<oplus> u = y \<oplus> w"
          and hp: "p \<in> A" and hq: "q \<in> A" and hr: "r \<in> A" and hs: "s \<in> A" and ht: "t \<in> A"
          and hu: "u \<in> A" and he: "e = (p, q, r, s, t, u)" by blast
        then have "p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u = z \<oplus> x \<ominus> (z \<oplus> w) \<oplus> y \<oplus> w"
          by (smt (verit, ccfv_threshold) assms(4) associative composition_closed hwG hxG hyG hzG
              inverse_closed subset_eq)
        also have "... = y \<oplus> x" using hxG hyG hzG hwG
          by (smt (verit) associative commutative composition_closed inverse_closed invertible
              invertible_right_inverse2)
        finally have "d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u" using hxy by simp
        thus "e \<in> {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and>
          u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}" using he hp hq hr hs ht hu by auto
      qed
      thus "X \<subseteq> {(p, q, r, s, t, u) |p q r s t u.
               p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
        using hX by auto
    qed
    thus "\<exists>y\<in>(\<lambda>(a, b). a) ` Y'. \<exists>x\<in>(\<lambda>(a, b). a) ` X'. (\<Union>(z, w)\<in>{(z, w) |z w. z \<in> A \<and> w \<in> A \<and>
      popular_sum (z \<oplus> x) c A \<and> popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}.
      {(p, q, r, s, t, u) |p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and>
      p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w}) \<subseteq> {(p, q, r, s, t, u) |p q r s t u.
      p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
      using hx hy by meson
  qed
  moreover have "\<forall> d \<in> sumset ?C ?B. card {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and>
    r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u} \<ge> c ^ 15 * (card A) ^ 5 / 2 ^13"
  proof
    fix d assume "d \<in> sumset ((\<lambda>(a, b). a) ` Y') ((\<lambda>(a, b). a) ` X')"
    then obtain x y where hy: "y \<in> ?C" and hx: "x \<in> ?B" and hsub:
    "(\<Union> (z, w) \<in> {(z, w) | z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
    popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}.
    {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
    t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})
    \<subseteq> {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
    s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}" using hdsub by meson
    have "{(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
    s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u} \<subseteq> A \<times> A \<times> A \<times> A \<times> A \<times> A" by auto
    then have fin: "finite {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
      s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
      using finite_subset assms(1) finite_cartesian_product by fastforce
    have "c ^ 15 * (card A) ^ 5 / 2 ^13 \<le> card (\<Union> (z, w) \<in> {(z, w) | z w. z \<in> A \<and> w \<in> A \<and> popular_sum (z \<oplus> x) c A \<and>
    popular_sum (z \<oplus> w) c A \<and> popular_sum (y \<oplus> w) c A}.
    {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and> s \<in> A \<and>
    t \<in> A \<and> u \<in> A \<and> p \<oplus> q = z \<oplus> x \<and> r \<oplus> s = z \<oplus> w \<and> t \<oplus> u = y \<oplus> w})"
      using card_ineq3 hx hy by auto
    also have "... \<le> card {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
    s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}"
      using hsub card_mono fin by auto
    finally show "c ^ 15 * (card A) ^ 5 / 2 ^13 \<le> card {(p, q, r, s, t, u) | p q r s t u. p \<in> A \<and> q \<in> A \<and> r \<in> A \<and>
    s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}" by linarith
  qed
  moreover have "pairwise (\<lambda> s t. disjnt ((\<lambda> d. {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and>
    r \<in> A \<and>  s \<in> A \<and>  t \<in> A \<and>  u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}) s)
    ((\<lambda> d. {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and>
    r \<in> A \<and>  s \<in> A \<and>  t \<in> A \<and>  u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u}) t)) (sumset ?C ?B)"
    unfolding disjnt_def by (intro pairwiseI) (auto)
  moreover have "\<forall> d \<in> sumset ?C ?B. ((\<lambda> d. {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and>
    r \<in> A \<and>  s \<in> A \<and>  t \<in> A \<and>  u \<in> A \<and> (d = p \<oplus> q \<oplus> r \<oplus>  s \<oplus>  t \<oplus> u)}) d) \<subseteq> A \<times> A \<times> A \<times> A \<times> A \<times> A"
    by blast
  ultimately have "card (sumset ?C ?B) \<le> ((card A) ^ 6) / (c^15 *(card A)^5 /2^13)"
    using assms(1) hA finite_cartesian_product card_cartesian_product_6[of "A"]
    pos card_le_image_div[of "A \<times> A \<times> A \<times> A \<times> A \<times> A" "(\<lambda> d. {(p, q, r, s, t, u)| p q r s t u. p \<in> A \<and> q \<in> A \<and>
    r \<in> A \<and> s \<in> A \<and> t \<in> A \<and> u \<in> A \<and> d = p \<oplus> q \<ominus> (r \<oplus> s) \<oplus> t \<oplus> u})" "sumset ?C ?B"
    "(c^15 * (card A)^5 /2^13)"] by auto
  also have "... = (card A ^ 6 / card A ^ 5) / (c^15 / 2^13)"
    using hA assms(3) field_simps by simp
  also have "... = (card A) / (c ^ 15 / 2 ^ 13)"
    using cardApow by metis
  finally have final: "card (sumset ?C ?B) \<le> 2 ^ 13 * (1 / c ^ 15) * real (card A)"
    by argo
  have "0 < c ^ 4 * real (card A) / 16" and "0 < c ^ 2 * real (card A) / 4" using assms(2) hA by auto
  then have "?B \<noteq> {}" and "?C \<noteq> {}" using cardB cardC by auto
  then show ?thesis using hCA hBA cardC cardB final that by auto
qed

end
end


section {* Quorums *}

theory Quorums
imports Main
begin

locale quorums =
  fixes quorums::"'a set set"
  assumes "\<And> q1 q2 . \<lbrakk>q1 \<in> quorums; q2 \<in> quorums\<rbrakk> \<Longrightarrow> q1 \<inter> q2 \<noteq> {}"
    and "quorums \<noteq> {}" and "\<And> q . q \<in> quorums \<Longrightarrow> finite q"
begin

lemma quorum_inter_witness[elim]:
  assumes "q1 \<in> quorums" and "q2 \<in> quorums"
  obtains a where "a \<in> q1" and "a \<in> q2"
  using assms quorums_axioms
by (metis disjoint_iff_not_equal quorums_def)

lemma quorums_value_same:
  assumes "q1 \<in> quorums" and "q2 \<in> quorums"
  and "\<And> a . a \<in> q1 \<Longrightarrow> f a = x"
  and "\<And> a . a \<in> q2 \<Longrightarrow> f a = y"
  shows "x = y" using assms
by (metis quorum_inter_witness)

end

subsection {* Quorums defined in terms of cardinality. *}

locale card_quorums =
  fixes acceptors
  assumes "acceptors \<noteq> {}" and "finite acceptors"
begin

definition nas where "nas \<equiv> card acceptors"

definition quorums where
  "quorums \<equiv> Set.filter (\<lambda> s . 2 * card s > nas) (Pow acceptors)"

lemma not_e:"quorums \<noteq> {}"
proof -
  have "acceptors \<in> quorums" using card_quorums_axioms
    by (auto simp add:quorums_def nas_def card_quorums_def)
  thus ?thesis by auto
qed

lemma inter: assumes "q1 \<in> quorums" "q2 \<in> quorums"
shows "q1 \<inter> q2 \<noteq> {}"
proof -
  have 1:"2 * card q1 > nas" and 2:"q1 \<subseteq> acceptors" using assms(1)
  by (simp_all add:quorums_def)
  moreover
  have 4:"2 * card q2 > nas" and 3:"q2 \<subseteq> acceptors" using assms(2)
  by (simp_all add:quorums_def)
  have "card q1 + card q2 > nas"
  by (smt 1 4 add_le_imp_le_right add_left_mono add_lessD1 leD less_imp_add_positive less_le linorder_neqE_nat mult_2)
  with 2 3 show "q1 \<inter> q2 \<noteq> {}"
  by (metis Int_Un_distrib2 card_Un_disjoint card_mono card_quorums_axioms card_quorums_def finite_subset inf.orderE inf.orderI leD nas_def)
qed

print_locale quorums

sublocale quorums quorums
apply(unfold_locales)
    apply (metis inter)
  apply (metis not_e)
apply (metis card_quorums_axioms card_quorums_def infinite_super subset)
done

end

end


(*  Title:      IP_Partition_Preliminaries
    Authors:    Cornelius Diekmann, Max Haslbeck
*)
(*SetPartitioning.thy
  Original Author: Max Haslbeck, 2015*)
section\<open>Partition a Set by a Specific Constraint\<close>
theory IP_Partition_Preliminaries
imports Main
begin

text\<open>Will be used for the IP address space partition of a firewall.
    However, this file is completely generic in terms of sets, it only imports Main.

    It will be used in @{file \<open>../Service_Matrix.thy\<close>}.
    Core idea: This file partitions @{typ "'a set set"} by some magic condition.
    Later, we will show that this magic condition implies that all IPs that have been grouped
    by the magic condition show the same behaviour for a simple firewall.\<close>

(* disjoint, ipPartition definitions *)

definition disjoint :: "'a set set \<Rightarrow> bool" where
  "disjoint ts \<equiv> \<forall>A \<in> ts. \<forall>B \<in> ts. A \<noteq> B \<longrightarrow> A \<inter> B = {}"

text_raw\<open>We will call two partitioned sets \emph{complete} iff @{term "\<Union> ss = \<Union> ts"}.\<close>

text\<open>The condition we use to partition a set. If this holds and
      @{term A} is the set of IP addresses in each rule in a firewall,
      then @{term B} is a partition of @{term "\<Union> A"} where each member has the same behavior
      w.r.t the firewall ruleset.\<close>
text\<open>@{term A} is the carrier set and @{term B}* should be a partition of @{term "\<Union> A"}
     which fulfills the following condition:\<close>
definition ipPartition :: "'a set set \<Rightarrow> 'a set set \<Rightarrow> bool" where
  "ipPartition A B \<equiv> \<forall>a \<in> A. \<forall>b \<in> B. a \<inter> b = {} \<or> b \<subseteq> a"

definition disjoint_list :: "'a set list \<Rightarrow> bool" where
  "disjoint_list ls \<equiv> distinct ls \<and> disjoint (set ls)"

context begin
  (*internal*)
  private fun disjoint_list_rec :: "'a set list \<Rightarrow> bool" where
    "disjoint_list_rec [] = True" |
    "disjoint_list_rec (x#xs) = (x \<inter> \<Union>(set xs) = {} \<and> disjoint_list_rec xs)"

  private lemma disjoint_equi: "disjoint_list_rec ts \<Longrightarrow> disjoint (set ts)"
    apply(induction ts)
     apply(simp_all add: disjoint_def)
    by fast

  private lemma disjoint_list_disjoint_list_rec: "disjoint_list ts \<Longrightarrow> disjoint_list_rec ts"
    apply(induction ts)
     apply(simp_all add: disjoint_list_def disjoint_def)
    by fast

  private definition addSubsetSet :: "'a set \<Rightarrow> 'a set set \<Rightarrow> 'a set set" where
    "addSubsetSet s ts = insert (s - \<Union>ts) (((\<inter>) s) ` ts) \<union> ((\<lambda>x. x - s) ` ts)"

  private fun partitioning :: "'a set list \<Rightarrow> 'a set set \<Rightarrow> 'a set set" where
    "partitioning [] ts = ts" |
    "partitioning (s#ss) ts = partitioning ss (addSubsetSet s ts)"

  text\<open>simple examples\<close>
  lemma "partitioning [{1::nat,2},{3,4},{5,6,7},{6},{10}] {} = {{10}, {6}, {5, 7}, {}, {3, 4}, {1, 2}}" by eval
  lemma "\<Union> {{1::nat,2},{3,4},{5,6,7},{6},{10}} = \<Union> (partitioning [{1,2},{3,4},{5,6,7},{6},{10}] {})" by eval
  lemma "disjoint (partitioning [{1::nat,2},{3,4},{5,6,7},{6},{10}] {})" by eval
  lemma "ipPartition {{1::nat,2},{3,4},{5,6,7},{6},{10}} (partitioning [{1::nat,2},{3,4},{5,6,7},{6},{10}] {})" by eval

  lemma "ipPartition A {}" by(simp add: ipPartition_def)

  lemma ipPartitionUnion: "ipPartition As Cs \<and> ipPartition Bs Cs \<longleftrightarrow> ipPartition (As \<union> Bs) Cs"
    unfolding ipPartition_def by fast

  private lemma disjointAddSubset: "disjoint ts \<Longrightarrow> disjoint (addSubsetSet a ts)"
    by (auto simp add: disjoint_def addSubsetSet_def)

  private lemma coversallAddSubset:"\<Union> (insert a ts) = \<Union> (addSubsetSet a ts)"
    by (auto simp add: addSubsetSet_def)

  private lemma ipPartioningAddSubset0: "disjoint ts \<Longrightarrow> ipPartition ts (addSubsetSet a ts)"
    apply(simp add: addSubsetSet_def ipPartition_def)
    apply(safe)
      apply blast
     apply(simp_all add: disjoint_def)
     apply blast+
    done

  private lemma ipPartitioningAddSubset1: "disjoint ts \<Longrightarrow> ipPartition (insert a ts) (addSubsetSet a ts)"
    apply(simp add: addSubsetSet_def ipPartition_def)
    apply(safe)
      apply blast
     apply(simp_all add: disjoint_def)
     apply blast+
  done

  private lemma addSubsetSetI:
    "s - \<Union>ts \<in> addSubsetSet s ts"
    "t \<in> ts \<Longrightarrow> s \<inter> t \<in> addSubsetSet s ts"
    "t \<in> ts \<Longrightarrow> t - s \<in> addSubsetSet s ts"
  unfolding addSubsetSet_def by blast+

  private lemma addSubsetSetE:
    assumes "A \<in> addSubsetSet s ts"
    obtains "A = s - \<Union>ts" | T where "T \<in> ts" "A = s \<inter> T" | T where "T \<in> ts" "A = T - s"
    using assms unfolding addSubsetSet_def by blast

  private lemma Union_addSubsetSet: "\<Union>(addSubsetSet b As) = b \<union> \<Union>As"
    unfolding addSubsetSet_def by auto

  private lemma addSubsetSetCom: "addSubsetSet a (addSubsetSet b As) = addSubsetSet b (addSubsetSet a As)"
  proof -
    {
      fix A a b assume "A \<in> addSubsetSet a (addSubsetSet b As)"
      hence "A \<in> addSubsetSet b (addSubsetSet a As)"
      apply (rule addSubsetSetE)
      proof(goal_cases)
        case 1
        assume "A = a - \<Union>(addSubsetSet b As)"
        hence "A = (a - \<Union>As) - b" by (auto simp add: Union_addSubsetSet)
        thus ?thesis by (auto intro: addSubsetSetI)
      next
        case (2 T)
        have "A = b \<inter> (a - \<Union>As) \<or> (\<exists>S\<in>As. A = b \<inter> (a \<inter> S)) \<or> (\<exists>S\<in>As. A = (a \<inter> S) - b)"
          by (rule addSubsetSetE[OF 2(1)]) (auto simp: 2(2))
        thus ?thesis by (blast intro: addSubsetSetI)
      next
        case (3 T)
        have "A = b - \<Union>(addSubsetSet a As) \<or> (\<exists>S\<in>As. A = b \<inter> (S - a)) \<or> (\<exists>S\<in>As. A = (S - a) - b)"
          by (rule addSubsetSetE[OF 3(1)]) (auto simp: 3(2) Union_addSubsetSet)
        thus ?thesis by (blast intro: addSubsetSetI)
      qed
    }
    thus ?thesis by blast
  qed

  private lemma ipPartitioningAddSubset2: "ipPartition {a} (addSubsetSet a ts)"
    apply(simp add: addSubsetSet_def ipPartition_def)
    by blast

  private lemma disjointPartitioning_helper :"disjoint As \<Longrightarrow> disjoint (partitioning ss As)"
    proof(induction ss arbitrary: As)
    case Nil thus ?case by(simp)
    next
    case (Cons s ss)
      from Cons.prems disjointAddSubset have d: "disjoint (addSubsetSet s As)" by fast
      from Cons.IH d have "disjoint (partitioning ss (addSubsetSet s As))" .
      thus ?case by simp
    qed

  private lemma disjointPartitioning: "disjoint (partitioning ss {})"
    proof -
      have "disjoint {}" by(simp add: disjoint_def)
      from this disjointPartitioning_helper show ?thesis by fast
    qed

  private lemma coversallPartitioning:"\<Union> (set ts) = \<Union> (partitioning ts {})"
  proof -
    have "\<Union> (set ts \<union> As) = \<Union> (partitioning ts As)" for As
    apply(induction ts arbitrary: As)
     apply(simp_all)
    by (metis Union_addSubsetSet sup_left_commute)
    thus ?thesis by (metis sup_bot.right_neutral)
  qed

  private lemma "\<Union> As = \<Union> Bs \<Longrightarrow> ipPartition As Bs \<Longrightarrow> ipPartition As (addSubsetSet a Bs)"
    by(auto simp add: ipPartition_def addSubsetSet_def)

  private lemma ipPartitionSingleSet: "ipPartition {t} (addSubsetSet t Bs)
               \<Longrightarrow> ipPartition {t} (partitioning ts (addSubsetSet t Bs))"
    apply(induction ts arbitrary: Bs t)
     apply(simp_all)
    by (metis addSubsetSetCom ipPartitioningAddSubset2)

  private lemma ipPartitioning_helper: "disjoint As \<Longrightarrow> ipPartition (set ts) (partitioning ts As)"
    proof(induction ts arbitrary: As)
    case Nil thus ?case by(simp add: ipPartition_def)
    next
    case (Cons t ts)
      from Cons.prems ipPartioningAddSubset0 have d: "ipPartition As (addSubsetSet t As)" by blast
      from Cons.prems Cons.IH d disjointAddSubset ipPartitioningAddSubset1
      have e: "ipPartition (set ts) (partitioning ts (addSubsetSet t As))" by blast
      from ipPartitioningAddSubset2 Cons.prems
      have "ipPartition {t} (addSubsetSet t As)" by blast
      from this Cons.prems ipPartitionSingleSet
      have f: "ipPartition {t} (partitioning ts (addSubsetSet t As))" by fast
      have "set (t#ts) = insert t (set ts)" by auto
      from ipPartitionUnion have "\<And> As Bs Cs. ipPartition As Cs \<Longrightarrow> ipPartition Bs Cs \<Longrightarrow> ipPartition (As \<union> Bs) Cs" by fast
      with this e f
      have "ipPartition (set (t # ts)) (partitioning ts (addSubsetSet t As))" by fastforce
      thus ?case by simp
   qed

  private lemma ipPartitioning: "ipPartition (set ts) (partitioning ts {})"
    proof -
      have "disjoint {}" by(simp add: disjoint_def)
      from this ipPartitioning_helper show ?thesis by fast
    qed

  (* OPTIMIZATION PROOFS *)

  private lemma inter_dif_help_lemma: "A \<inter> B = {}  \<Longrightarrow> B - S = B - (S - A)"
    by blast

  private lemma disjoint_list_lem: "disjoint_list ls \<Longrightarrow> \<forall>s \<in> set(ls). \<forall>t \<in> set(ls). s \<noteq> t \<longrightarrow> s \<inter> t = {}"
    proof(induction ls)
    qed(simp_all add: disjoint_list_def disjoint_def)

  private lemma disjoint_list_empty: "disjoint_list []"
    by (simp add: disjoint_list_def disjoint_def)

  private lemma disjoint_sublist: "disjoint_list (t#ts) \<Longrightarrow> disjoint_list ts"
    proof(induction ts arbitrary: t)
    qed(simp_all add: disjoint_list_empty disjoint_list_def disjoint_def)

  private fun intersection_list :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "intersection_list _ [] = []" |
    "intersection_list s (t#ts) = (s \<inter> t)#(intersection_list s ts)"

  private fun intersection_list_opt :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "intersection_list_opt _ [] = []" |
    "intersection_list_opt s (t#ts) = (s \<inter> t)#(intersection_list_opt (s - t) ts)"

  private lemma disjoint_subset: "disjoint A \<Longrightarrow> a \<in> A \<Longrightarrow> b \<subseteq> a \<Longrightarrow> disjoint ((A - {a}) \<union> {b})"
    apply(simp add: disjoint_def)
    by blast

  private lemma disjoint_intersection: "disjoint A \<Longrightarrow> a \<in> A \<Longrightarrow> disjoint ({a \<inter> b} \<union> (A - {a}))"
    apply(simp add: disjoint_def)
    by(blast)

  private lemma intList_equi: "disjoint_list_rec ts \<Longrightarrow> intersection_list s ts = intersection_list_opt s ts"
    proof(induction ts)
    case Nil thus ?case by simp
    next
    case (Cons t ts)
    from Cons.prems have "intersection_list_opt s ts = intersection_list_opt (s - t) ts"
      proof(induction ts arbitrary: s t)
      case Nil thus ?case by simp
      next
      case Cons
      have "\<forall>t \<in> set ts. u \<inter> t = {} \<Longrightarrow> intersection_list_opt s ts = intersection_list_opt (s - u) ts"
        for u
        apply(induction ts arbitrary: s u)
         apply(simp_all)
        by (metis Diff_Int_distrib2 Diff_empty Diff_eq Un_Diff_Int sup_bot.right_neutral)
      with Cons show ?case
        apply(simp)
        by (metis Diff_Int_distrib2 Diff_empty Un_empty inf_sup_distrib1)
      qed
    with Cons show ?case by simp
    qed

  private fun difference_list :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "difference_list _ [] = []" |
    "difference_list s (t#ts) = (t - s)#(difference_list s ts)"

  private fun difference_list_opt :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "difference_list_opt _ [] = []" |
    "difference_list_opt s (t#ts) = (t - s)#(difference_list_opt (s - t) ts)"

  private lemma difList_equi: "disjoint_list_rec ts \<Longrightarrow> difference_list s ts = difference_list_opt s ts"
    proof(induction ts arbitrary: s)
    case Nil thus ?case by simp
    next
    case (Cons t ts)
      have difference_list_opt_lem0: "\<forall>t \<in> set(ts). u \<inter> t = {} \<Longrightarrow>
                                        difference_list_opt s ts = difference_list_opt (s - u) ts"
      for u proof(induction ts arbitrary: s u)
      case Cons thus ?case
         apply(simp_all add: inter_dif_help_lemma)
         by (metis Diff_Int_distrib2 Diff_eq Un_Diff_Int sup_bot.right_neutral)
      qed(simp)
      have "disjoint_list_rec (t # ts) \<Longrightarrow> difference_list_opt s ts = difference_list_opt (s - t) ts"
      proof(induction ts arbitrary: s t)
      case Cons thus ?case
         apply(simp_all add: difference_list_opt_lem0)
         by (metis Un_empty inf_sup_distrib1 inter_dif_help_lemma)
      qed(simp)
    with Cons show ?case by simp
  qed

  private fun partList0 :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partList0 s [] = []" |
    "partList0 s (t#ts) = (s \<inter> t)#((t - s)#(partList0 s ts))"

  private lemma partList0_set_equi: "set(partList0 s ts) = (((\<inter>) s) ` (set ts)) \<union> ((\<lambda>x. x - s) ` (set ts))"
    by(induction ts arbitrary: s) auto

  private lemma partList_sub_equi0: "set(partList0 s ts) =
                             set(difference_list s ts) \<union> set(intersection_list s ts)"
    by(induction ts arbitrary: s) simp+

  private fun partList1 :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partList1 s [] = []" |
    "partList1 s (t#ts) = (s \<inter> t)#((t - s)#(partList1 (s - t) ts))"

  private lemma partList_sub_equi: "set(partList1 s ts) =
                            set(difference_list_opt s ts) \<union> set(intersection_list_opt s ts)"
    by(induction ts arbitrary: s) (simp_all)

  private lemma partList0_partList1_equi: "disjoint_list_rec ts \<Longrightarrow> set (partList0 s ts) = set (partList1 s ts)"
    by (simp add: partList_sub_equi partList_sub_equi0 intList_equi difList_equi)

  private fun partList2 :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partList2 s [] = []" |
    "partList2 s (t#ts) = (if s \<inter> t = {} then  (t#(partList2 (s - t) ts))
                                         else (s \<inter> t)#((t - s)#(partList2 (s - t) ts)))"

  private lemma partList2_empty: "partList2 {} ts = ts"
    by(induction ts) (simp_all)

  private lemma partList1_partList2_equi: "set(partList1 s ts) - {{}} = set(partList2 s ts) - {{}}"
    by(induction ts arbitrary: s) (auto)

  private fun partList3 :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partList3 s [] = []" |
    "partList3 s (t#ts) = (if s = {} then (t#ts) else
                            (if s \<inter> t = {} then (t#(partList3 (s - t) ts))
                                           else
                              (if t - s = {} then (t#(partList3 (s - t) ts))
                                             else (t \<inter> s)#((t - s)#(partList3 (s - t) ts)))))"

  private lemma partList2_partList3_equi: "set(partList2 s ts) - {{}} = set(partList3 s ts) - {{}}"
    apply(induction ts arbitrary: s)
     apply(simp; fail)
    apply(simp add: partList2_empty)
    by blast

  fun partList4 :: "'a set \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partList4 s [] = []" |
    "partList4 s (t#ts) = (if s = {} then (t#ts) else
                            (if s \<inter> t = {} then (t#(partList4 s ts))
                                           else
                              (if t - s = {} then (t#(partList4 (s - t) ts))
                                             else (t \<inter> s)#((t - s)#(partList4 (s - t) ts)))))"

  private lemma partList4: "partList4 s ts = partList3 s ts"
    apply(induction ts arbitrary: s)
     apply(simp; fail)
    apply (simp add: Diff_triv)
    done

  private lemma partList0_addSubsetSet_equi: "s \<subseteq> \<Union>(set ts) \<Longrightarrow>
                                      addSubsetSet s (set ts) - {{}} = set(partList0 s ts) - {{}}"
    by(simp add: addSubsetSet_def partList0_set_equi)

  private fun partitioning_nontail :: "'a set list \<Rightarrow> 'a set set \<Rightarrow> 'a set set" where
    "partitioning_nontail [] ts = ts" |
    "partitioning_nontail (s#ss) ts = addSubsetSet s (partitioning_nontail ss ts)"

  private lemma partitioningCom: "addSubsetSet a (partitioning ss ts) = partitioning ss (addSubsetSet a ts)"
    apply(induction ss arbitrary: a ts)
     apply(simp; fail)
    apply(simp add: addSubsetSetCom)
  done

  private lemma partitioning_nottail_equi: "partitioning_nontail ss ts = partitioning ss ts"
    apply(induction ss arbitrary: ts)
     apply(simp; fail)
    apply(simp add: addSubsetSetCom partitioningCom)
  done

  fun partitioning1 :: "'a set list \<Rightarrow> 'a set list \<Rightarrow> 'a set list" where
    "partitioning1 [] ts = ts" |
    "partitioning1 (s#ss) ts = partList4 s (partitioning1 ss ts)"

  lemma partList4_empty: "{} \<notin> set ts \<Longrightarrow> {} \<notin> set (partList4 s ts)"
    apply(induction ts arbitrary: s)
     apply(simp; fail)
    by auto

  lemma partitioning1_empty0: "{} \<notin> set ts \<Longrightarrow> {} \<notin> set (partitioning1 ss ts)"
    apply(induction ss arbitrary: ts)
     apply(simp; fail)
    apply(simp add: partList4_empty)
    done

  lemma partitioning1_empty1: "{} \<notin> set ts \<Longrightarrow>
                                set(partitioning1 ss ts) - {{}} = set(partitioning1 ss ts)"
    by(simp add: partitioning1_empty0)

  lemma partList4_subset: "a \<subseteq> \<Union>(set ts) \<Longrightarrow> a \<subseteq> \<Union>(set (partList4 b ts))"
    apply(simp add: partList4)
    apply(induction ts arbitrary: a b)
     apply(simp; fail)
    apply(simp)
    by fast

  private lemma "a \<noteq> {} \<Longrightarrow> disjoint_list_rec (a # ts) \<longleftrightarrow> disjoint_list_rec ts \<and> a \<inter> \<Union> (set ts) = {}" by auto

  lemma partList4_complete0: "s \<subseteq> \<Union>(set ts) \<Longrightarrow> \<Union>(set (partList4 s ts)) = \<Union>(set ts)"
  unfolding partList4
  proof(induction ts arbitrary: s)
    case Nil thus ?case by(simp)
    next
    case Cons thus ?case by (simp add: Diff_subset_conv Un_Diff_Int inf_sup_aci(7) sup.commute)
  qed

  private lemma partList4_disjoint: "s \<subseteq> \<Union>(set ts) \<Longrightarrow> disjoint_list_rec ts \<Longrightarrow>
                             disjoint_list_rec (partList4 s ts)"
    apply(induction ts arbitrary: s)
     apply(simp; fail)
    apply(simp add: Diff_subset_conv)
    apply(rule conjI)
     apply (metis Diff_subset_conv Int_absorb1 Int_lower2 Un_absorb1 partList4_complete0)
    apply(safe)
       using partList4_complete0 apply (metis Diff_subset_conv Diff_triv IntI UnionI)
      apply (metis Diff_subset_conv Diff_triv)
     using partList4_complete0 by (metis Diff_subset_conv IntI UnionI)+

  lemma union_set_partList4: "\<Union>(set (partList4 s ts)) = \<Union>(set ts)"
    by (induction ts arbitrary: s, auto)

  private lemma partList4_distinct_hlp: assumes "a \<noteq> {}" "a \<notin> set ts" "disjoint (insert a (set ts))"
    shows "a \<notin> set (partList4 s ts)"
  proof -
    from assms have "\<not> a \<subseteq> \<Union>(set ts)" unfolding disjoint_def by fastforce
    hence "\<not> a \<subseteq> \<Union>(set (partList4 s ts))" using union_set_partList4 by metis
    thus ?thesis by blast
  qed

  private lemma partList4_distinct: "{} \<notin> set ts \<Longrightarrow> disjoint_list ts \<Longrightarrow> distinct (partList4 s ts)"
    proof(induction ts arbitrary: s)
    case Nil thus ?case by simp
    next
    case(Cons t ts)
      have x1: "\<And>x xa xb xc.
         t \<notin> set ts \<Longrightarrow>
         disjoint (insert t (set ts)) \<Longrightarrow>
         xa \<in> t \<Longrightarrow>
         xb \<in> s \<Longrightarrow>
         xb \<in> t \<Longrightarrow>
         xb \<notin> {} \<Longrightarrow>
         xc \<in> s \<Longrightarrow>
         xc \<notin> {} \<Longrightarrow>
         t \<inter> s \<in> set (partList4 (s - t) ts) \<Longrightarrow>
         \<not> t \<inter> s \<subseteq> \<Union>(set (partList4 (s - t) ts))"
        by(simp add: union_set_partList4 disjoint_def, force) (*1s*)
      have x2: "\<And>x xa xb xc.
         t \<notin> set ts \<Longrightarrow>
         disjoint (insert t (set ts)) \<Longrightarrow>
         x \<in> t \<Longrightarrow>
         xa \<in> t \<Longrightarrow>
         xa \<notin> s \<Longrightarrow>
         xb \<in> s \<Longrightarrow>
         xc \<in> s \<Longrightarrow>
         \<not> t - s \<subseteq> \<Union>(set (partList4 (s - t) ts))"
        by(simp add: union_set_partList4 disjoint_def, force) (*1s*)
      from Cons have IH: "distinct (partList4 s ts)" for s
        using disjoint_sublist list.set_intros(2) by auto
      from Cons.prems(1,2) IH show ?case
      unfolding disjoint_list_def
       apply(simp)
       apply(safe)
            apply(metis partList4_distinct_hlp)
           apply(metis partList4_distinct_hlp)
          apply(metis partList4_distinct_hlp)
         apply blast
        using x1 apply blast
       using x2 by blast
    qed

  lemma partList4_disjoint_list: assumes "s \<subseteq> \<Union>(set ts)" "disjoint_list ts" "{} \<notin> set ts"
    shows "disjoint_list (partList4 s ts)"
    unfolding disjoint_list_def
    proof
      from assms(2,3) show "distinct (partList4 s ts)"
        using partList4_distinct disjoint_list_def by auto
      show "disjoint (set (partList4 s ts))"
      proof -
        have disjoint_list_disjoint_list_rec: "disjoint_list ts \<Longrightarrow> disjoint_list_rec ts"
        proof(induction ts)
        case Cons thus ?case by(auto simp add: disjoint_list_def disjoint_def)
        qed(simp)
        with partList4_disjoint disjoint_equi assms(1,2) show ?thesis by blast
      qed
    qed

  lemma partitioning1_subset: "a \<subseteq> \<Union> (set ts) \<Longrightarrow> a \<subseteq> \<Union> (set (partitioning1 ss ts))"
    apply(induction ss arbitrary: ts a)
     apply(simp)
    apply(simp add: partList4_subset)
    done

  lemma partitioning1_disjoint_list: "{} \<notin> (set ts) \<Longrightarrow> \<Union> (set ss) \<subseteq> \<Union> (set ts) \<Longrightarrow>
                                 disjoint_list ts \<Longrightarrow> disjoint_list (partitioning1 ss ts)"
  proof(induction ss)
  case Nil thus ?case by simp
  next
  case(Cons t ts) thus ?case
    apply(clarsimp)
    apply(rule partList4_disjoint_list)
      using partitioning1_subset apply(metis)
     apply(blast)
    using partitioning1_empty0 apply(metis)
    done
  qed

  private lemma partitioning1_disjoint: "\<Union> (set ss) \<subseteq> \<Union> (set ts) \<Longrightarrow>
                                 disjoint_list_rec ts \<Longrightarrow> disjoint_list_rec (partitioning1 ss ts)"
    proof(induction ss arbitrary: ts)
    qed(simp_all add: partList4_disjoint partitioning1_subset)

  private lemma partitioning_equi: "{} \<notin> set ts \<Longrightarrow> disjoint_list_rec ts \<Longrightarrow> \<Union> (set ss) \<subseteq> \<Union> (set ts) \<Longrightarrow>
           set(partitioning1 ss ts) = partitioning_nontail ss (set ts) - {{}}"
    proof(induction ss)
    case Nil thus ?case by simp
    next
    case (Cons s ss)
      have addSubsetSet_empty: "addSubsetSet s (ts - {{}}) - {{}} = addSubsetSet s ts - {{}}"
        for s and ts::"'a set set"
        unfolding addSubsetSet_def by blast
      have r: "disjoint_list_rec ts \<Longrightarrow> s \<subseteq> \<Union>(set ts) \<Longrightarrow>
                                        addSubsetSet s (set ts) - {{}} = set (partList4 s ts) - {{}}"
        for ts::"'a set list"
        unfolding partList4
        by(simp add: partList0_addSubsetSet_equi partList0_partList1_equi partList1_partList2_equi
                   partList2_partList3_equi)
      have 1: "disjoint_list_rec (partitioning1 ss ts)"
        using partitioning1_disjoint Cons.prems by auto
      from Cons.prems have 2: "s \<subseteq> \<Union>(set (partitioning1 ss ts))"
        by (meson Sup_upper dual_order.trans list.set_intros(1) partitioning1_subset)
      from Cons have IH: "set (partitioning1 ss ts) = partitioning_nontail ss (set ts) - {{}}" by auto
      with r[OF 1 2] show ?case by (simp add: partList4_empty addSubsetSet_empty)
    qed

  lemma ipPartitioning_helper_opt: "{} \<notin> set ts \<Longrightarrow> disjoint_list ts \<Longrightarrow> \<Union> (set ss) \<subseteq> \<Union> (set ts)
                                    \<Longrightarrow> ipPartition (set ss) (set (partitioning1 ss ts))"
    apply(drule disjoint_list_disjoint_list_rec)
    apply(simp add: partitioning_equi partitioning_nottail_equi)
    by (meson Diff_subset disjoint_equi ipPartition_def ipPartitioning_helper subsetCE)

  lemma complete_helper: "{} \<notin> set ts \<Longrightarrow> \<Union> (set ss) \<subseteq> \<Union> (set ts)\<Longrightarrow>
        \<Union> (set ts) = \<Union> (set (partitioning1 ss ts))"
    apply(induction ss arbitrary: ts)
     apply(simp_all)
    by (metis partList4_complete0)

  lemma "partitioning1  [{1::nat},{2},{}] [{1},{},{2},{3}] = [{1}, {}, {2}, {3}]" by eval

  lemma partitioning_foldr: "partitioning X B = foldr addSubsetSet X B"
    apply(induction X)
     apply(simp; fail)
    apply(simp)
    by (metis partitioningCom)

  lemma "ipPartition (set X) (foldr addSubsetSet X {})"
    apply(subst partitioning_foldr[symmetric])
    using ipPartitioning by auto

  lemma "\<Union> (set X) = \<Union> (foldr addSubsetSet X {})"
    apply(subst partitioning_foldr[symmetric])
    by (simp add: coversallPartitioning)

  lemma "partitioning1 X B = foldr partList4 X B"
    by(induction X)(simp_all)

  lemma "ipPartition (set X) (set (partitioning1 X [UNIV]))"
    apply(rule ipPartitioning_helper_opt)
      by(simp_all add: disjoint_list_def disjoint_def)

  lemma "(\<Union>(set (partitioning1 X [UNIV]))) = UNIV"
    apply(subgoal_tac "UNIV = \<Union> (set (partitioning1 X [UNIV]))")
     prefer 2
     apply(rule complete_helper[where ts="[UNIV]", simplified])
    apply(simp)
    done

end
end


(*  Title:      Restriction.thy
    Author:     Sven Linker

Restrict a function from cars to lanes to a given view. Will be
used for claim and reservation functions of Traffic Snapshots.
*)

section\<open>Restrict Claims and Reservations to a View\<close>
text \<open>
To model that a view restricts the number of lanes a car may
perceive, we define a function \(restrict\) taking a view \(v\), a function
\(f\) from cars to lanes and a car \(f\), and returning the intersection
between \(f(c)\) and the set of lanes of \(v\). This function
will in the following only be applied to the functions yielding
reservations and claims from traffic snapshots.

The lemmas of this section describe the connection between
\(restrict\) and the different operations on traffic snapshots
and views (e.g., the transition relations or the fact that
reservations and claims are consecutive).
\<close>

theory Restriction
  imports Traffic Views
begin

locale restriction = view+traffic
begin

definition restrict :: "view \<Rightarrow> (cars \<Rightarrow> lanes) \<Rightarrow> cars \<Rightarrow> lanes"
  where  "restrict v f c ==  (f c) \<sqinter>  lan v"

lemma restrict_def':" restrict v f c = lan v \<sqinter> f c"
  using inf_commute restriction.restrict_def by auto

lemma restrict_subseteq:"restrict v f c \<sqsubseteq> f c"
  using inf_le1 restrict_def by auto

lemma restriction_disj:"(v=u--w) \<longrightarrow> (restrict u f c) \<sqinter> (restrict w f c) = \<emptyset>"
proof
  assume assm: "v=u--w"
  then have 1:"lan u \<sqinter> lan w = \<emptyset>" using vchop_def
    by (metis inf_commute inter_empty1 nat_int.consec_inter_empty nat_int.nchop_def)
  from assm have "(restrict u f c) \<sqinter> (restrict w f c) \<sqsubseteq> lan u \<sqinter> lan w "
    by (meson inf_mono restriction.restrict_view)
  with 1 show  "(restrict u f c) \<sqinter> (restrict w f c) = \<emptyset>"
    by (simp add: bot.extremum_uniqueI)
qed

lemma vertical_chop_restriction_res_consec_or_empty:
  "(v=v1--v2) \<and> restrict v1 (res ts) c \<noteq> \<emptyset> \<and> consec ((lan v1)) ((lan v2)) \<and>
    \<not>consec (restrict v1 (res ts) c) (restrict v2 (res ts) c)
      \<longrightarrow> restrict v2 (res ts) c = \<emptyset>"
proof
  assume assm:
    "(v=v1--v2) \<and> restrict v1 (res ts) c \<noteq> \<emptyset> \<and>
      consec ((lan v1)) ((lan v2)) \<and>
      \<not>consec (restrict v1 (res ts) c) (restrict v2 (res ts) c)"
  hence "restrict v1 (res ts) c = \<emptyset> \<or> restrict v2 (res ts) c = \<emptyset> \<or>
   (maximum (restrict v1 (res ts) c)+1 \<noteq>minimum (restrict v2 (res ts) c))"
    using nat_int.consec_def by blast
  hence empty_or_non_consec:"restrict v2 (res ts) c = \<emptyset> \<or>
    (maximum (restrict v1 (res ts) c)+1 \<noteq>minimum (restrict v2 (res ts) c))"
    using assm by blast
  have consec_lanes:"consec ((lan v1)) ((lan v2))" by (simp add: assm)
  have subs:"restrict v2 (res ts) c \<sqsubseteq> ((lan v2))" using restrict_view
    by simp
  show "restrict v2 (res ts) c = \<emptyset>"
  proof (rule ccontr)
    assume non_empty:"restrict v2 (res ts) c \<noteq> \<emptyset>"
    hence max:
      "(maximum (restrict v1 (res ts) c)+1 \<noteq>minimum (restrict v2 (res ts) c))"
      using empty_or_non_consec by blast
    have ex_n:" \<exists>n. n \<in> Rep_nat_int (restrict v2 (res ts) c)"
      using nat_int.el.rep_eq non_empty nat_int.non_empty_elem_in by auto
    have res1_or2:"|(res ts) c| = 1 \<or> |(res ts) c| = 2"
      by (metis Suc_1 atLeastOneRes atMostTwoRes dual_order.antisym le_SucE)
    then show False
    proof
      assume res_one:"|(res ts) c|=1"
      then obtain n where one_lane:"Rep_nat_int ((res ts) c) =  {n}"
        using singleton by blast
      then have "n \<in> Rep_nat_int (restrict v1 (res ts) c)"
        by (metis assm equals0D nat_int.el.rep_eq less_eq_nat_int.rep_eq
            nat_int.non_empty_elem_in restrict_res singletonI subset_singletonD)
      then have "Rep_nat_int (restrict v2 (res ts) c) = {}"
        by (metis one_lane assm inf.absorb1 less_eq_nat_int.rep_eq restriction.restrict_res
            restriction_disj subset_singleton_iff)
      thus False
        using ex_n by blast
    next
      assume res_two:"|(res ts) c| = 2"
      hence ex_two_ln:" (\<exists>n . Rep_nat_int ((res ts) c) = {n,n+1})"
        using consecutiveRes by blast
      then obtain n where n_def:"Rep_nat_int ((res ts) c) = {n,n+1}"  by blast
      hence rep_restrict_v1:"Rep_nat_int (restrict v1 (res ts) c) \<subseteq> {n,n+1}"
        using less_eq_nat_int.rep_eq restrict_res by blast
      hence
        "n \<in> Rep_nat_int (restrict v1 (res ts) c) \<or>
         n+1 \<in> Rep_nat_int(restrict v1 (res ts) c)"
        using assm bot.extremum_unique less_eq_nat_int.rep_eq by fastforce
      thus False
      proof
        assume suc_n_in_res_v1:"n+1 \<in> Rep_nat_int (restrict v1 (res ts) c)"
        hence suc_n_in_v1:"n+1 \<in> Rep_nat_int ((lan v1))"
          using less_eq_nat_int.rep_eq restrict_view by blast
        hence  "n+1 \<notin> Rep_nat_int (lan v2)"
          using assm vchop_def nat_int.nchop_def nat_int.consec_in_exclusive1
            nat_int.el.rep_eq nat_int.not_in.rep_eq by blast
        hence suc_n_not_in_res_v2:"n+1 \<notin> Rep_nat_int (restrict v2 (res ts) c)"
          using less_eq_nat_int.rep_eq subs by blast
        have "\<forall>m . m \<^bold>\<in> lan v2 \<longrightarrow> m \<ge> minimum (lan v2)"
          by (metis consec_lanes nat_int.minimum_def nat_int.consec_def
            nat_int.el.rep_eq atLeastAtMost_iff nat_int.leq_min_inf
            nat_int.rep_non_empty_means_seq)
        then have "\<forall>m . m \<^bold>\<in> lan v2 \<longrightarrow> m > maximum (lan v1)"
          using assm nat_int.consec_def by fastforce
        then have "\<forall>m . m \<^bold>\<in> lan v2 \<longrightarrow> m > n+1"
          using consec_lanes nat_int.maximum_def nat_int.card_seq
            nat_int.consec_def suc_n_in_v1
          by (simp add: nat_int.consec_lesser)
        then have "n \<notin> Rep_nat_int ((lan v2))"
          using suc_n_in_v1 assm nat_int.consec_def nat_int.el.rep_eq
          by auto
        hence "n\<notin> Rep_nat_int (restrict v2 (res ts) c)"
          using less_eq_nat_int.rep_eq rev_subsetD subs by blast
        hence "Rep_nat_int (restrict v2 (res ts) c) = {}"
          using insert_absorb insert_ident insert_not_empty n_def less_eq_nat_int.rep_eq
            restrict_res singleton_insert_inj_eq subset_insert suc_n_not_in_res_v2
          by fastforce
        thus False using ex_n by blast
      next
        assume n_in_res_v1:"n \<in> Rep_nat_int (restrict v1 (res ts) c)"
        hence n_not_in_v2:"n \<notin> Rep_nat_int ((lan v2))"
          using assm vchop_def nat_int.nchop_def  nat_int.consec_in_exclusive1
            nat_int.consec_in_exclusive2 nat_int.el.rep_eq nat_int.not_in.rep_eq
          by (meson less_eq_nat_int.rep_eq restrict_view subsetCE)
        hence n_not_in_res_v2:"n \<notin> Rep_nat_int (restrict v2 (res ts) c)"
          using less_eq_nat_int.rep_eq subs by blast
        show False
        proof (cases "n+1 \<in> Rep_nat_int(restrict v2 (res ts) c) ")
          case False
          hence "Rep_nat_int (restrict v2 (res ts) c) = {}"
            using insert_absorb insert_ident insert_not_empty n_def n_not_in_res_v2
              less_eq_nat_int.rep_eq restrict_res singleton_insert_inj_eq' subset_insert
            by fastforce
          thus False using ex_n by blast
        next
          case True
          obtain NN :: "nat set \<Rightarrow> nat \<Rightarrow> nat set" where
            "\<forall>x0 x1. (\<exists>v2. x0 = insert x1 v2 \<and> x1 \<notin> v2)
              = (x0 = insert x1 (NN x0 x1) \<and> x1 \<notin> NN x0 x1)"
            by moura
          then have f1:
            "Rep_nat_int (restrict v2 (res ts) c) =
              insert (n + 1) (NN (Rep_nat_int (restrict v2 (res ts) c)) (n + 1))
             \<and> n + 1 \<notin> NN (Rep_nat_int (restrict v2 (res ts) c)) (n + 1)"
            by (meson mk_disjoint_insert True)
          then have
            "insert (n + 1) (NN (Rep_nat_int (restrict v2 (res ts) c)) (n+1))
              \<subseteq> {n+1}\<union>{}"
            by (metis (no_types) insert_is_Un n_def n_not_in_res_v2 less_eq_nat_int.rep_eq
                restrict_res subset_insert)
          then have "{n + 1} = Rep_nat_int (restrict v2 (res ts) c)"
            using f1 by blast
          then have min:"nat_int.minimum (restrict v2 (res ts) c) = n+1"
            by (metis (no_types) Min_singleton nat_int.minimum_def non_empty)
          then have suc_n_in_v2:"n+1 \<^bold>\<in> (lan v2)"
            using nat_int.el.rep_eq less_eq_nat_int.rep_eq subs True
            by auto
          have "\<forall>m . m \<^bold>\<in> lan v1 \<longrightarrow> m \<le> maximum (lan v1)"
            by (metis atLeastAtMost_iff consec_lanes nat_int.maximum_def  nat_int.consec_def
              nat_int.el.rep_eq nat_int.leq_max_sup nat_int.rep_non_empty_means_seq)
          then have "\<forall>m . m \<^bold>\<in> lan v1 \<longrightarrow> m < minimum (lan v2)" using assm
            using nat_int.consec_lesser nat_int.minimum_in nat_int.consec_def
            by auto
          then have "\<forall>m . m \<^bold>\<in> lan v1 \<longrightarrow> m < n+1"
            using consec_lanes  nat_int.card_seq nat_int.consec_def suc_n_in_v2
              nat_int.consec_lesser by auto
          then have suc_n_not_in_v1:"n+1 \<notin> Rep_nat_int ((lan v1))"
            using nat_int.el.rep_eq by auto
          have suc_n_not_in_res_v1:"n+1 \<notin> Rep_nat_int (restrict v1 (res ts) c)"
            using less_eq_nat_int.rep_eq restrict_view suc_n_not_in_v1 by blast
          from rep_restrict_v1 and n_in_res_v1 have res_v1_singleton:
            "Rep_nat_int (restrict v1 (res ts) c) = {n}"
            using Set.set_insert insert_absorb2 insert_commute singleton_insert_inj_eq'
              subset_insert suc_n_not_in_res_v1 by blast
          have max: "nat_int.maximum (restrict v1 (res ts) c) = n"
            by (metis Rep_nat_int_inverse nat_int.leq_max_sup' order_refl
                res_v1_singleton nat_int.rep_single)
          from min and max have
            "maximum (restrict v1 (res ts) c)+1 = minimum (restrict v2 (res ts) c)"
            by auto
          thus False
            using empty_or_non_consec non_empty by blast
        qed
      qed
    qed
  qed
qed

lemma restriction_consec_res:"(v=u--w)
  \<longrightarrow> restrict u (res ts) c = \<emptyset> \<or> restrict w (res ts) c = \<emptyset>
  \<or>  consec (restrict u (res ts) c) ( restrict w (res ts) c)"
proof
  assume assm:"v=u--w"
  then show "restrict u (res ts) c = \<emptyset> \<or> restrict w (res ts) c = \<emptyset>
  \<or>  consec (restrict u (res ts) c) ( restrict w (res ts) c)"
  proof (cases "res ts c =\<emptyset>")
    case True
    show ?thesis
      by (simp add: True inter_empty1 restriction.restrict_def')
  next
    case False
    then have "res ts c \<noteq> \<emptyset>" by best
    show ?thesis
      by (metis (no_types, lifting) assm inter_empty1 nat_int.nchop_def
          restriction.restrict_def restriction.vertical_chop_restriction_res_consec_or_empty
          view.vchop_def)
  qed
qed

lemma restriction_clm_res_disjoint:
  "(restrict v (res ts) c) \<sqinter> (restrict v (clm ts) c) = \<emptyset>"
  by (metis (no_types) inf_assoc nat_int.inter_empty2 restriction.restrict_def
      restrict_def' traffic.disjoint)

lemma el_in_restriction_clm_singleton:
  "n \<^bold>\<in> restrict v (clm ts) c \<longrightarrow> (clm ts) c = Abs_nat_int({n})"
proof
  assume n_in_restr:"n \<^bold>\<in> restrict v (clm ts) c"
  hence "n \<^bold>\<in> ((clm ts) c \<sqinter> (lan v))" by (simp add: restrict_def)
  hence "n \<in> (Rep_nat_int (clm ts c) \<inter> Rep_nat_int (lan v))"
    by (simp add: inf_nat_int.rep_eq nat_int.el_def)
  hence n_in_rep_clm:"n \<in> (Rep_nat_int ((clm ts) c))" by simp
  then have "(clm ts) c \<noteq> \<emptyset>" using nat_int.el.rep_eq nat_int.non_empty_elem_in
    by auto
  then have "|(clm ts) c| \<ge> 1"
    by (simp add: nat_int.card_non_empty_geq_one)
  then have "|(clm ts) c| = 1" using atMostOneClm le_antisym
    by blast
  with n_in_rep_clm show "(clm ts) c = Abs_nat_int({n})"
    by (metis Rep_nat_int_inverse nat_int.singleton singletonD)
qed

lemma restriction_clm_v2_non_empty_v1_empty:
  "(v=u--w) \<and> restrict w (clm ts) c \<noteq> \<emptyset> \<and>
    consec ((lan u)) ((lan w)) \<longrightarrow> restrict u (clm ts) c = \<emptyset>"
proof
  assume assm:"(v=u--w) \<and> restrict w (clm ts) c \<noteq> \<emptyset> \<and> consec (lan u) (lan w)"
  obtain n where n_in_res_v2: "(n \<^bold>\<in> restrict w (clm ts) c)"
    using assm maximum_in by blast
  have "(clm ts) c = Abs_nat_int({n})"
    using n_in_res_v2  by (simp add: el_in_restriction_clm_singleton)
  then show "restrict u (clm ts) c = \<emptyset>"
    by (metis assm inf.absorb_iff2 inf_commute less_eq_nat_int.rep_eq
        n_in_res_v2 nat_int.el.rep_eq nat_int.in_singleton restriction.restrict_subseteq
        restriction.restriction_disj subsetI)
qed

lemma restriction_consec_clm:
  "(v=u--w) \<and> consec (lan u) (lan w)
    \<longrightarrow> restrict u (clm ts) c = \<emptyset> \<or> restrict w (clm ts) c = \<emptyset>"
  using nat_int.card_un_add nat_int.card_empty_zero restriction_un atMostOneClm
    nat_int.chop_add1 nat_int.inter_distr1 nat_int.inter_empty1 nat_int.un_empty_absorb1
    nat_int.un_empty_absorb2 nat_int.nchop_def restrict_def vchop_def
    restriction_clm_v2_non_empty_v1_empty
  by meson

lemma restriction_add_res:
  "(v=u--w)
    \<longrightarrow> |restrict v (res ts) c|=|restrict u (res ts) c|+|restrict w (res ts) c|"
proof
  assume assm: "v=u--w"
  then have 1:"restrict u (res ts) c \<sqinter> restrict w (res ts) c = \<emptyset>"
    using restriction.restriction_disj by auto
  from assm have "restrict v (res ts) c=restrict u (res ts) c\<squnion>restrict w (res ts) c"
    using restriction.restriction_un by blast
  with 1 show " |restrict v (res ts) c|=|restrict u (res ts) c|+|restrict w (res ts) c|"
    by (metis add.right_neutral add_cancel_left_left assm nat_int.card_empty_zero
        nat_int.card_un_add nat_int.un_empty_absorb1 nat_int.un_empty_absorb2
        restriction.restriction_consec_res)
qed

lemma restriction_eq_view_card:"restrict v f c = lan v \<longrightarrow> |restrict v f c| =|lan v|"
  by simp

lemma restriction_card_mon1:"(v=u--w) \<longrightarrow> |restrict u f c| \<le> |restrict v f c|"
  using nat_int.card_subset_le restriction_mon1 by (simp )

lemma restriction_card_mon2:"(v=u--w) \<longrightarrow> |restrict w f c| \<le> |restrict v f c|"
  using nat_int.card_subset_le restriction_mon2 by (simp )

lemma restriction_res_leq_two:"|restrict v (res ts) c| \<le> 2"
  using atMostTwoRes nat_int.card_subset_le le_trans restrict_res
  by metis

lemma restriction_clm_leq_one:"|restrict v (clm ts) c| \<le> 1"
  using atMostOneClm nat_int.card_subset_le le_trans restrict_clm
  by metis

lemma restriction_add_clm:
  "(v=u--w)
    \<longrightarrow> |restrict v (clm ts) c|=|restrict u (clm ts) c|+|restrict w (clm ts) c|"
proof
  assume assm:"v=u--w"
  have "|restrict u (clm ts) c| = 1 \<or> |restrict u (clm ts) c| = 0"
    by (metis One_nat_def le_0_eq le_SucE restriction.restriction_clm_leq_one)
  then show "|restrict v (clm ts) c|=|restrict u (clm ts) c|+|restrict w (clm ts) c|"
  proof
    assume clm_u:"|restrict u (clm ts) c| = 1"
    have "restrict u (clm ts) c \<noteq> \<emptyset>"
      using clm_u card_non_empty_geq_one by auto
    then have "|restrict w (clm ts) c| = 0"
      by (metis (no_types) assm card_empty_zero inf_commute inter_empty2
          nat_int.nchop_def restriction.restrict_def
          restriction.restriction_clm_v2_non_empty_v1_empty view.vchop_def)
    then show ?thesis
      by (metis Nat.add_0_right assm clm_u inf.absorb1 inf_commute
          restriction.restriction_card_mon1 restriction.restriction_clm_leq_one)
  next
    assume no_clm_u:"|restrict u (clm ts) c| = 0"
    then have "|restrict w (clm ts) c| = 1 \<or> |restrict w (clm ts) c| = 0"
      by (metis One_nat_def le_0_eq le_SucE restriction.restriction_clm_leq_one)
    then show ?thesis
    proof
      assume "|restrict w (clm ts) c| = 1"
      then show ?thesis
        by (metis no_clm_u add_cancel_left_left antisym_conv3 assm leD
            restriction.restriction_card_mon2 restriction.restriction_clm_leq_one)
    next
      assume no_clm_w:"|restrict w (clm ts) c| = 0"
      then have "|restrict v (clm ts) c| = 0"
        by (metis assm card_empty_zero chop_empty
            nat_int.card_non_empty_geq_one nat_int.nchop_def no_clm_u
            restriction.restriction_un)
      then show ?thesis
        using no_clm_u no_clm_w by linarith
    qed
  qed
qed

lemma restriction_card_mon_trans:
  "(v=v1--v2) \<and> (v2=v3--v4) \<and> |restrict v3 f c| = 1 \<longrightarrow> |restrict v f c|\<ge>1"
  by (metis One_nat_def Suc_leI neq0_conv not_less_eq_eq
      restriction_card_mon1 restriction_card_mon2)

lemma restriction_card_somewhere_mon:
  "(v=vl\<parallel>v1)\<and>(v1=v2\<parallel>vr)\<and>(v2=vu--v3)\<and>(v3=v'--vd)\<and>|restrict v' f c|=1
      \<longrightarrow> |restrict v f c| \<ge> 1"
proof
  assume assm:
    "(v=vl\<parallel>v1)\<and>(v1=v2\<parallel>vr)\<and>(v2=vu--v3)\<and>(v3=v'--vd)\<and>|restrict v' f c|=1"
  then have "|restrict v2 f c| \<ge> 1" using restriction_card_mon_trans by blast
  then show "|restrict v f c| \<ge> 1" using restriction_stable1 restriction_stable2 assm
    by metis
qed

lemma restrict_eq_lan_subs:
  "|restrict v f c| = |lan v| \<and> (restrict v f c \<sqsubseteq> lan v) \<longrightarrow> restrict v f c = lan v"
proof
  assume assm:"|restrict v f c| = |lan v| \<and> (restrict v f c \<sqsubseteq> lan v)"
  have "|restrict v f c| = 0 \<or> |restrict v f c| \<noteq> 0" by auto
  thus "restrict v f c = lan v"
  proof (cases "|restrict v f c| = 0")
    case True
    then have res_empty:"restrict v f c = \<emptyset>"
      by (metis nat_int.card_non_empty_geq_one nat_int.card_empty_zero)
    then have "lan v = \<emptyset>"
      by (metis assm nat_int.card_empty_zero nat_int.card_non_empty_geq_one)
    then show "restrict v f c = lan v"
      using res_empty by auto
  next
    case False
    show "restrict v f c = lan v"
    proof (rule ccontr)
      assume non_eq:"restrict v f c \<noteq> lan v"
       then have "restrict v f c < lan v"
         by (simp add: assm less_le)
       then have "|restrict v f c| < |lan v|"
         using card_subset_less by blast
       then show False using assm by simp
    qed
  qed
qed

lemma create_reservation_restrict_union:
  "(ts\<^bold>\<midarrow>r(c)\<^bold>\<rightarrow>ts')
    \<longrightarrow> restrict v (res ts') c = restrict v (res ts) c \<squnion> restrict v (clm ts) c"
proof
  assume assm:"(ts\<^bold>\<midarrow>r(c)\<^bold>\<rightarrow>ts')"
  hence res_ts':"res ts' c = res ts c \<squnion> clm ts c"
    by (simp add: create_reservation_def)
  show " restrict v (res ts') c = restrict v (res ts) c \<squnion> restrict v (clm ts) c"
  proof (cases "clm ts c = \<emptyset>")
    case True
    hence res_ts'eq_ts:"res ts' c = res ts c"
      using res_ts' nat_int.un_empty_absorb1 by simp
    from True have restrict_clm:"restrict v (clm ts) c = \<emptyset>"
      using nat_int.inter_empty2 restrict_def by simp
    from res_ts'eq_ts have "restrict v (res ts') c = restrict v (res ts) c"
      by (simp add: restrict_def)
    thus ?thesis using restrict_clm
      by (simp add: nat_int.un_empty_absorb1)
  next
    case False
    hence "consec (clm ts c) (res ts c) \<or> consec (res ts c) (clm ts c)"
      by (simp add: clm_consec_res)
    thus ?thesis
    proof
      assume consec:"consec (clm ts c) (res ts c)"
      then show ?thesis
        using inter_distr1 res_ts' restriction.restrict_def
        by (simp add: Un_ac(3) inf_commute nat_int.union_def)
    next
      assume consec:"consec (res ts c) (clm ts c)"
      then show ?thesis
        by (simp add: inter_distr2 res_ts' restriction.restrict_def)
    qed
  qed
qed

  (* switch lemmas *)
lemma switch_restrict_stable:"(v=c>u) \<longrightarrow> restrict v f d = restrict u f d"
  using switch_def by (simp add: restrict_def)
end
end