diff --git a/thys/Balog_Szemeredi_Gowers/Additive_Combinatorics_Preliminaries.thy b/thys/Balog_Szemeredi_Gowers/Additive_Combinatorics_Preliminaries.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Additive_Combinatorics_Preliminaries.thy
@@ -0,0 +1,452 @@
+section\<open>Background material in additive combinatorics\<close>
+
+text \<open>This section outlines some background definitions and basic lemmas in additive combinatorics
+based on the notes by Gowers \cite{Gowersnotes}. \<close>
+(*
+  Session: Balog_Szemeredi_Gowers
+  Title:   Additive_Combinatorics_Preliminaries.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds 
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Additive_Combinatorics_Preliminaries
+  imports 
+    Pluennecke_Ruzsa_Inequality.Pluennecke_Ruzsa_Inequality
+begin
+
+subsection\<open>Additive quadruples and additive energy\<close>
+
+context additive_abelian_group
+
+begin
+
+definition additive_quadruple:: "'a \<Rightarrow>'a \<Rightarrow>'a \<Rightarrow> 'a \<Rightarrow> bool" where 
+  "additive_quadruple a b c d  \<equiv> a \<in> G \<and> b \<in> G \<and> c \<in> G \<and> d \<in> G \<and> a \<oplus> b = c \<oplus> d"
+
+lemma additive_quadruple_aux:
+  assumes "additive_quadruple a b c d"
+  shows "d = a \<oplus> b \<ominus> c"
+  by (metis additive_quadruple_def assms associative commutative inverse_closed invertible 
+    invertible_right_inverse2)
+
+lemma additive_quadruple_diff:
+  assumes "additive_quadruple a b c d"
+  shows "a \<ominus> c = d \<ominus> b"
+  by (smt (verit, del_insts) additive_quadruple_def assms associative commutative 
+      composition_closed inverse_closed invertible invertible_inverse_inverse invertible_right_inverse2)
+
+definition additive_quadruple_set:: "'a set \<Rightarrow> ('a \<times> 'a \<times> 'a \<times> 'a) set" where 
+  "additive_quadruple_set A \<equiv> {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+  additive_quadruple a b c d}"
+
+lemma additive_quadruple_set_sub:
+  "additive_quadruple_set A \<subseteq> {(a, b, c, d) | a b c d. d = a \<oplus> b \<ominus> c \<and> a \<in> A \<and> b \<in> A \<and> 
+    c \<in> A \<and> d \<in> A}" using additive_quadruple_set_def additive_quadruple_def additive_quadruple_aux 
+  by auto
+
+definition additive_energy:: "'a set \<Rightarrow> real" where 
+  "additive_energy A \<equiv> card (additive_quadruple_set A) / (card A)^3" 
+
+lemma card_ineq_aux_quadruples:
+  assumes "finite A"
+  shows "card (additive_quadruple_set A) \<le> (card A)^3"
+
+proof-
+  define f:: "'a \<times> 'a \<times> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a" where "f = (\<lambda> (a, b, c, d) . (a, b, c))"
+  have hinj: "inj_on f {(a, b, c, d) | a b c d. d = a \<oplus> b \<ominus> c \<and> a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A}"
+  unfolding inj_on_def f_def by auto
+  moreover have himage: "f ` {(a, b, c, d) | a b c d. d = a \<oplus> b \<ominus> c \<and> a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A} \<subseteq> A \<times> A \<times> A"
+    unfolding f_def by auto
+  ultimately have "card (additive_quadruple_set A) \<le> card ({(a, b, c, d) | a b c d. d = a \<oplus> b \<ominus> c \<and> a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A})"
+    using card_mono inj_on_finite[of "f"] assms additive_quadruple_set_sub finite_SigmaI
+    by (metis (no_types, lifting))
+  also have "... \<le> card (A \<times> A \<times> A)" using himage hinj assms card_inj_on_le finite_SigmaI
+    by (metis (no_types, lifting))
+  finally show ?thesis by (simp add: card_cartesian_product power3_eq_cube)
+qed
+  
+lemma additive_energy_upper_bound: "additive_energy A \<le> 1"
+
+proof (cases "finite A")
+  assume hA: "finite A"
+  show ?thesis unfolding additive_energy_def using card_ineq_aux_quadruples hA 
+    card_cartesian_product power3_eq_cube by (simp add: divide_le_eq)
+next
+  assume "infinite A"
+  thus ?thesis unfolding additive_energy_def by simp
+qed
+
+
+subsection\<open>On sums\<close>
+
+definition f_sum:: "'a \<Rightarrow>'a set \<Rightarrow> nat" where
+  "f_sum d A \<equiv> card {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}"
+
+
+lemma pairwise_disjnt_sum_1:
+  "pairwise (\<lambda>s t. disjnt ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)}) s) 
+    ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)}) t)) (sumset A A)"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma pairwise_disjnt_sum_2: 
+  "pairwise disjnt ((\<lambda> d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}) ` (sumset A A))"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma sum_Union_span:
+  assumes "A \<subseteq> G"
+  shows "\<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)}) ` (sumset A A)) = A \<times> A"
+
+proof
+  show "\<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)}) ` (sumset A A)) \<subseteq> A \<times> A" by blast
+next
+  show "A \<times> A \<subseteq> \<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)}) ` (sumset A A))"
+  proof (intro subsetI)
+    fix x assume hxA: "x \<in> A \<times> A"
+    then obtain y z where hxyz: "x = (y, z)" and hy: "y \<in> A" and hz:"z \<in> A" by blast
+    show "x \<in> (\<Union>d\<in>(sumset A A).{(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d})"
+      using hy hz assms hxA hxyz by auto
+  qed
+qed
+
+lemma f_sum_le_card:
+  assumes "finite A" and "A \<subseteq> G"
+  shows "f_sum d A \<le> card A"
+
+proof-
+  define f:: "('a \<times> 'a) \<Rightarrow> 'a" where "f \<equiv> (\<lambda> (a, b). a)"
+  have "inj_on f {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}"
+  unfolding f_def 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
+    hcase: "(case x of (a, b) \<Rightarrow> a) = (case y of (a, b) \<Rightarrow> a)"
+  then obtain x1 x2 y1 y2 where hx: "x = (x1, x2)" and hy:"y = (y1, y2)" and h1: "x1 \<oplus> x2 = d" and
+    h2: "y1 \<oplus> y2 = d" and hx1: "x1 \<in> A" and hx2: "x2 \<in> A" and hy1: "y1 \<in> A" and hy2: "y2 \<in> A" by blast
+  have hxsub: "x2 = d \<ominus> x1"
+    using h1 hx1 hx2 assms by (metis additive_abelian_group.inverse_closed composition_closed 
+     additive_abelian_group_axioms commutative invertible invertible_left_inverse2 subsetD)
+  have hysub: "y2 = d \<ominus> y1"  
+    using h2 hy1 hy2 assms by (metis inverse_closed commutative composition_closed hy1 hy2 
+        invertible invertible_left_inverse2 subset_iff)
+  show "x = y" using hx hy hxsub hysub hcase by auto
+  qed
+  moreover have "f ` {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d} \<subseteq> A" using f_def by auto
+  ultimately show ?thesis using card_mono assms f_sum_def card_image[of "f"] 
+    by (metis (mono_tags, lifting))
+qed
+
+lemma f_sum_card:
+  assumes "A \<subseteq> G" and hA: "finite A"
+  shows "(\<Sum> d \<in> (sumset A A). (f_sum d A)) = (card A)^2"
+
+proof-
+  have fin: "\<forall> X \<in> ((\<lambda> d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d) }) ` (sumset A A)). finite X"
+  proof 
+    fix X assume hX: "X \<in> (\<lambda>d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}) ` (sumset A A)"
+    then obtain d where hXd: "X = {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}" by blast
+    show "finite X" using hA hXd finite_subset finite_cartesian_product
+      by (smt (verit, best) mem_Collect_eq mem_Sigma_iff rev_finite_subset subrelI)
+  qed
+  have "(\<Sum>d\<in>(sumset A A). f_sum d A) = card (A \<times> A)"
+    unfolding f_sum_def
+    using sum_card_image[of "sumset A A" "(\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<oplus> b = d)})"] 
+      pairwise_disjnt_sum_1 hA finite_sumset card_Union_disjoint[of "((\<lambda>d. {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = d}) ` sumset A A)"] 
+      fin pairwise_disjnt_sum_2 hA finite_sumset sum_Union_span assms by auto
+  thus ?thesis using card_cartesian_product power2_eq_square by metis
+qed
+    
+lemma f_sum_card_eq:
+  assumes "A \<subseteq> G"
+  shows "\<forall> x \<in> sumset A A.  (f_sum x A)^2 = 
+    card {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}"
+
+proof
+  fix x assume "x \<in> sumset A A"
+  define C where hC: "C = {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and>
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}"
+  define f:: "'a \<times> 'a \<times> 'a \<times> 'a \<Rightarrow> ('a \<times> 'a) \<times> ('a \<times> 'a)" where "f = (\<lambda> (a, b, c, d). ((a, b), (c, d)))"
+  have hfinj: "inj_on f C" unfolding f_def by (intro inj_onI) (auto)
+  have "f ` C = {((a,b), (c,d)) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<oplus> b = x \<and> c \<oplus> d = x}"
+  proof
+    show "f ` C \<subseteq> {((a, b), (c, d)) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<oplus> b = x \<and> c \<oplus> d = x}"
+      unfolding f_def hC by auto
+  next
+    show "{((a, b), c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<oplus> b = x \<and> c \<oplus> d = x} \<subseteq> f ` C"
+    proof
+      fix z assume "z \<in> {((a, b), (c, d)) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<oplus> b = x \<and> c \<oplus> d = x}"
+      then obtain a b c d where hz: "z = ((a, b), (c, d))" and ha: "a \<in> A" and hb: "b \<in> A" and hc: "c \<in> A" and hd: "d \<in> A" 
+      and hab: "a \<oplus> b = x" and hcd: "c \<oplus> d = x" by blast
+      then have habcd: "(a, b, c, d) \<in> C" using additive_quadruple_def assms hC by auto
+      show "z \<in> f ` C" using hz f_def habcd by force
+    qed
+  qed
+  moreover have "{((a, b), c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<oplus> b = x \<and> c \<oplus> d = x} = 
+    {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = x} \<times> {(c, d) | c d. c \<in> A \<and> d \<in> A \<and> c \<oplus> d = x}" by blast
+  ultimately have "card C = card ({(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<oplus> b = x}) ^ 2"
+    using hfinj card_image[of "f"]  card_cartesian_product by (metis (no_types, lifting) Sigma_cong power2_eq_square)
+  thus "(f_sum x A)^2 = card ({(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x})" using hC f_sum_def by auto
+qed
+
+lemma pairwise_disjoint_sum:
+  "pairwise (\<lambda>s t. disjnt ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and>
+     additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) s) 
+     ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and>
+     additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) t)) (sumset A A)"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+
+lemma pairwise_disjnt_quadruple_sum:
+  "pairwise disjnt ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` (sumset A A))"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma quadruple_sum_Union_eq:
+   "\<Union> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` (sumset A A)) = additive_quadruple_set A"
+
+proof
+  show "(\<Union>x\<in>sumset A A.
+    {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and>
+    a \<oplus> b = x \<and> c \<oplus> d = x}) \<subseteq> additive_quadruple_set A"
+    unfolding additive_quadruple_set_def by (intro Union_least) (auto)
+next
+  show "additive_quadruple_set A \<subseteq> (\<Union>x\<in>sumset A A.
+    {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and>
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x})"
+  unfolding additive_quadruple_set_def additive_quadruple_def by (intro subsetI) (auto)
+qed
+
+lemma f_sum_card_quadruple_set: 
+  assumes hAG: "A \<subseteq> G" and hA: "finite A"
+  shows "(\<Sum> d \<in> (sumset A A). (f_sum d A)^2) = card (additive_quadruple_set A)"
+
+proof-
+  have fin: "\<forall> X \<in> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and>
+   additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` (sumset A A)). finite X"
+  proof
+    fix X assume "X \<in>  (\<lambda>x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` sumset A A"
+    then obtain x where hX: "X = {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}" 
+      by blast
+    show "finite X" using hA hX finite_subset finite_cartesian_product
+      by (smt (verit, best) mem_Collect_eq mem_Sigma_iff rev_finite_subset subrelI)
+  qed
+  have "(\<Sum>d\<in>sumset A A. (f_sum d A)\<^sup>2) = 
+    card (\<Union> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` (sumset A A)))"
+    using f_sum_card_eq hAG sum_card_image[of "sumset A A" "(\<lambda>x. {(a, b, c, d) |a b c d.
+      a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x})"] 
+      pairwise_disjoint_sum card_Union_disjoint[of "(\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and>
+      c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<oplus> b = x \<and> c \<oplus> d = x}) ` (sumset A A)"] 
+      fin pairwise_disjnt_quadruple_sum hA finite_sumset by auto
+  then show ?thesis using quadruple_sum_Union_eq by auto
+qed
+
+
+lemma  f_sum_card_quadruple_set_additive_energy: assumes "A \<subseteq> G" and "finite A"
+  shows "(\<Sum> d \<in> sumset A A. (f_sum d A)^2) = additive_energy A * (card A)^3"
+  using assms f_sum_card_quadruple_set additive_energy_def by force
+
+
+definition popular_sum:: "'a \<Rightarrow> real \<Rightarrow> 'a set \<Rightarrow> bool" where
+  "popular_sum d \<theta> A  \<equiv> f_sum d A \<ge> \<theta> * of_real (card A)"
+
+definition popular_sum_set:: "real \<Rightarrow> 'a set \<Rightarrow> 'a set" where
+  "popular_sum_set \<theta> A \<equiv> {d \<in> sumset A A. popular_sum d \<theta> A}"
+
+
+subsection\<open>On differences\<close>
+
+text\<open>The following material is directly analogous to the material given previously on sums.
+All definitions and lemmas are the corresponding ones for differences.
+E.g. @{term f_diff} corresponds to  @{term f_sum}. \<close>
+
+definition f_diff:: "'a \<Rightarrow>'a set \<Rightarrow> nat" where
+  "f_diff d A \<equiv> card {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}"
+
+lemma pairwise_disjnt_diff_1:
+  "pairwise (\<lambda>s t. disjnt ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d)}) s) 
+    ((\<lambda> d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d)}) t)) (differenceset A A)"
+  using disjnt_def by (intro pairwiseI) (auto)
+
+lemma pairwise_disjnt_diff_2: 
+  "pairwise disjnt ((\<lambda> d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}) ` (differenceset A A))"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma diff_Union_span:
+  assumes "A \<subseteq> G"
+  shows "\<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d)}) ` (differenceset A A)) = A \<times> A"
+
+proof
+  show "\<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d)}) ` (differenceset A A)) \<subseteq> A \<times> A"
+    by blast
+next
+  show "A \<times> A \<subseteq> \<Union> ((\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d)}) ` (differenceset A A))"
+  proof (intro subsetI)
+    fix x assume hxA: "x \<in> A \<times> A"
+    then obtain y z where hxyz: "x = (y, z)" and hy: "y \<in> A" and hz:"z \<in> A" by blast
+    show "x \<in> (\<Union>d\<in>(differenceset A A).{(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d})"
+      using hy hz assms hxA hxyz by auto
+  qed
+qed
+
+lemma f_diff_le_card:
+  assumes "finite A" and "A \<subseteq> G"
+  shows "f_diff d A \<le> card A"
+
+proof-
+define f:: "('a \<times> 'a) \<Rightarrow> 'a" where "f \<equiv> (\<lambda> (a, b). a)"
+  have "inj_on f {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}"
+  unfolding f_def proof (intro inj_onI)
+  fix x y assume "x \<in> {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}" and
+    "y \<in> {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}" and
+    hcase: "(case x of (a, b) \<Rightarrow> a) = (case y of (a, b) \<Rightarrow> a)"
+  then obtain x1 x2 y1 y2 where hx: "x = (x1, x2)" and hy:"y = (y1, y2)" and h1: "x1 \<ominus> x2 = d" and
+    h2: "y1 \<ominus> y2 = d" and hx1: "x1 \<in> A" and hx2: "x2 \<in> A" and hy1: "y1 \<in> A" and hy2: "y2 \<in> A" by blast
+  have hxsub: "x2 = x1 \<ominus> d"
+    using h1 assms associative commutative composition_closed hx1 hx2
+    by (smt (verit, best) inverse_closed invertible invertible_left_inverse2 subset_iff)
+  have hysub: "y2 = y1 \<ominus> d"
+    using h2 assms associative commutative composition_closed hy1 hy2
+    by (smt (verit, best) inverse_closed invertible invertible_left_inverse2 subset_iff)
+  show "x = y" using hx hy hxsub hysub hcase by auto
+  qed
+  moreover have "f ` {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d} \<subseteq> A" using f_def by auto
+  ultimately show ?thesis using card_mono assms f_diff_def card_image[of "f"] 
+    by (metis (mono_tags, lifting))
+qed
+
+lemma f_diff_card:
+  assumes "A \<subseteq> G" and hA: "finite A"
+  shows "(\<Sum> d \<in> (differenceset A A). f_diff d A) = (card A)^2"
+
+proof-
+  have fin: "\<forall> X \<in> ((\<lambda> d. {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d) }) ` (differenceset A A)). 
+    finite X"
+  proof
+      fix X assume hX: "X \<in> (\<lambda>d. {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}) ` (differenceset A A)"
+      then obtain d where hXd: "X = {(a, b) | a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}" and
+        "d \<in> (differenceset A A)" by blast
+      have hXA: "X \<subseteq> A \<times> A" using hXd by blast
+      show "finite X" using hXA hA finite_subset by blast
+    qed
+  have "(\<Sum>d\<in>(differenceset A A). f_diff d A) = card (A \<times> A)"
+    unfolding f_diff_def using sum_card_image[of "differenceset A A" 
+    "(\<lambda> d .{(a, b) | a b. a \<in> A \<and> b \<in> A \<and> (a \<ominus> b = d) })"] pairwise_disjnt_diff_1 
+    card_Union_disjoint[of "((\<lambda>d. {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> b = d}) ` differenceset A A)"]
+    fin pairwise_disjnt_diff_2 diff_Union_span assms hA finite_minusset finite_sumset by auto
+  thus ?thesis using card_cartesian_product power2_eq_square by metis
+qed
+    
+lemma f_diff_card_eq:
+  assumes "A \<subseteq> G"
+  shows "\<forall> x \<in> differenceset A A. (f_diff x A)^2 = 
+    card {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}"
+
+proof
+  fix x assume "x \<in> differenceset A A"
+  define C where hC: "C= {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x }"
+  define f:: "'a \<times> 'a \<times> 'a \<times> 'a \<Rightarrow> ('a \<times> 'a) \<times> ('a \<times> 'a)" where "f = (\<lambda> (a, b, c, d). ((a, c), (d, b)))"
+  have hfinj: "inj_on f C" using f_def by (intro inj_onI) (auto)
+  have "f ` C = {((a,c), (d,b)) | a b c d. 
+    a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<ominus> c = x \<and> d \<ominus> b = x}"
+  proof
+    show "f ` C \<subseteq> {((a, c), (d, b)) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<ominus> c = x \<and> d \<ominus> b = x}"
+      unfolding f_def hC by auto
+  next
+    show "{((a, c), d, b) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<ominus> c = x \<and> d \<ominus> b = x} \<subseteq> f ` C"
+    proof
+      fix z assume "z \<in> {((a, c), (d, b)) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<ominus> c = x \<and> d \<ominus> b = x}"
+      then obtain a b c d where hz: "z = ((a, c), (d, b))" and ha: "a \<in> A" and hb: "b \<in> A" and hc: "c \<in> A" and hd: "d \<in> A" 
+        and hab: "a \<ominus> c = x" and hcd: "d \<ominus> b = x" by blast
+      have "additive_quadruple a b c d"
+        using assms by (metis (no_types, lifting) ha hb hc hd additive_quadruple_def associative 
+        commutative composition_closed hab hcd inverse_closed invertible invertible_right_inverse2 subset_eq)
+      then have habcd: "(a, b, c, d) \<in> C" using hab hcd hC ha hb hc hd by blast
+      show "z \<in> f ` C" using hz f_def habcd image_iff by fastforce
+    qed
+  qed
+  moreover have "{((a, c), (d, b))|a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> a \<ominus> c = x \<and> d \<ominus> b = x} =
+  {(a, c) | a c. a \<in> A \<and> c \<in> A \<and> a \<ominus> c = x} \<times> {(d, b) | d b. d \<in> A \<and> b \<in> A \<and> d \<ominus> b = x}" by blast
+  moreover have "card C = card (f ` C)" using hfinj card_image[of "f"] by auto
+  ultimately have "card C =  card ({(a, c) | a c. a \<in> A \<and> c \<in> A \<and> a \<ominus> c = x}) ^ 2" 
+    using hfinj card_image[of "f"] card_cartesian_product Sigma_cong power2_eq_square by (smt (verit, best))
+  thus "(f_diff x A)\<^sup>2 = card  {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}" 
+    using f_diff_def hC by simp
+qed
+
+lemma pairwise_disjoint_diff:
+  "pairwise (\<lambda>s t. disjnt ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) s) 
+    ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) t)) (differenceset A A)"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma pairwise_disjnt_quadruple_diff:
+ "pairwise disjnt ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` (differenceset A A))"
+  unfolding disjnt_def by (intro pairwiseI) (auto)
+
+lemma quadruple_diff_Union_eq:
+  "\<Union> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` (differenceset A A)) = 
+    additive_quadruple_set A"
+
+proof
+  show "(\<Union>x\<in>differenceset A A. {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) \<subseteq> additive_quadruple_set A"
+    unfolding additive_quadruple_set_def by (intro Union_least)(auto)
+next
+  show "additive_quadruple_set A \<subseteq> (\<Union>x\<in>differenceset A A. 
+    {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x})"
+  proof (intro subsetI)
+    fix x assume"x \<in> additive_quadruple_set A"
+    then obtain x1 x2 x3 x4 where hx: "x = (x1, x2, x3, x4)" and hx1: "x1 \<in> A" and hx2: "x2 \<in> A" and hx3: "x3 \<in> A" 
+      and hx4: "x4 \<in> A" and hxadd: "additive_quadruple x1 x2 x3 x4" 
+      using additive_quadruple_set_def by auto
+    have hxmem: "(x1, x2, x3, x4) \<in> {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<ominus> c = x1 \<ominus> x3 \<and> d \<ominus> b = x1 \<ominus> x3}"
+      using additive_quadruple_diff hx1 hx2 hx3 hx4 hxadd by auto
+    show "x \<in> (\<Union>x\<in>differenceset A A. {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x})"
+      using hx hxmem hx1 hx3 additive_quadruple_def hxadd by auto
+  qed
+qed
+
+lemma f_diff_card_quadruple_set: 
+  assumes hAG: "A \<subseteq> G" and hA: "finite A"
+  shows "(\<Sum> d \<in> (differenceset A A). (f_diff d A)^2) = card (additive_quadruple_set A)"
+
+proof-
+  have fin: "\<forall> X \<in> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+    additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` (differenceset A A)). finite X"
+  proof
+    fix X assume "X \<in> (\<lambda>x. {(a, b, c, d) |a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` differenceset A A"
+    then obtain x where hX: "X = {(a, b, c, d) | a b c d. a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> 
+      additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}" and "x \<in> differenceset A A" by blast
+    show "finite X" using hX hA finite_subset finite_cartesian_product 
+      by (smt (verit, best) mem_Collect_eq mem_Sigma_iff rev_finite_subset subrelI) (*slow*)
+  qed
+  have "(\<Sum>d\<in>differenceset A A. (f_diff d A)\<^sup>2) = card (\<Union> ((\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and>
+    b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` (differenceset A A)))"
+    using f_diff_card_eq hAG sum_card_image[of "differenceset A A" "(\<lambda>x. {(a, b, c, d) |a b c d. 
+      a \<in> A \<and> b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x})"] 
+      pairwise_disjoint_diff card_Union_disjoint[of "(\<lambda> x. {(a, b, c, d) | a b c d. a \<in> A \<and> 
+      b \<in> A \<and> c \<in> A \<and> d \<in> A \<and> additive_quadruple a b c d \<and> a \<ominus> c = x \<and> d \<ominus> b = x}) ` 
+      (differenceset A A)"] fin pairwise_disjnt_quadruple_diff hA finite_minusset finite_sumset by auto
+  thus ?thesis using quadruple_diff_Union_eq by auto
+qed
+
+
+lemma f_diff_card_quadruple_set_additive_energy: assumes "A \<subseteq> G" and "finite A"
+  shows "(\<Sum> d \<in> differenceset A A. (f_diff d A)^2) = additive_energy A * (card A)^3"
+  using assms f_diff_card_quadruple_set additive_energy_def by force
+
+definition popular_diff:: "'a \<Rightarrow> real \<Rightarrow> 'a set \<Rightarrow> bool" where
+  "popular_diff d \<theta> A  \<equiv> f_diff d A \<ge> \<theta> * of_real (card A)"
+
+definition popular_diff_set:: "real \<Rightarrow> 'a set \<Rightarrow> 'a set" where
+  "popular_diff_set \<theta> A \<equiv> {d \<in> differenceset A A. popular_diff d \<theta> A}"
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Additive_Energy_Lower_Bounds.thy b/thys/Balog_Szemeredi_Gowers/Additive_Energy_Lower_Bounds.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Additive_Energy_Lower_Bounds.thy
@@ -0,0 +1,99 @@
+section\<open>Results on lower bounds on additive energy\<close>
+
+(*
+  Session: Balog_Szemeredi_Gowers
+  Title:   Additive_Energy_Lower_Bounds.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds 
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Additive_Energy_Lower_Bounds
+  imports 
+    Additive_Combinatorics_Preliminaries
+    Miscellaneous_Lemmas
+begin
+
+context additive_abelian_group
+
+begin
+
+text\<open>The following corresponds to Proposition 2.11 in Gowers's notes \cite{Gowersnotes}.\<close>
+
+proposition additive_energy_lower_bound_sumset: fixes C::real
+  assumes "finite A" and "A \<subseteq> G" and "(card (sumset A A)) \<le> C * card A" and "card A \<noteq> 0"
+  shows "additive_energy A \<ge> 1/C"
+
+proof-
+  have "(card A)^2 =  (\<Sum> x \<in> sumset A A. real (f_sum x A))"
+   using assms f_sum_card by (metis of_nat_sum)
+  also have "... \<le> (card((sumset A A)) powr(1/2)) * (\<Sum> x \<in> sumset A A . (f_sum x A)^2) powr(1/2)"
+    using Cauchy_Schwarz_ineq_sum2[of "\<lambda> d. 1" "\<lambda> d. f_sum d A"] by auto
+  also have "...\<le> ((C * (card A)) powr(1/2)) * ((\<Sum> x \<in> sumset A A . (f_sum x A)^2)) powr(1/2) "
+    by (metis mult.commute mult_left_mono assms(3) of_nat_0_le_iff powr_ge_pzero powr_mono2 
+        zero_le_divide_1_iff zero_le_numeral)
+  finally have "((card A)^2)^2 \<le> (((C * (card A)) powr(1/2)) * ((\<Sum> x \<in> sumset A A . (f_sum x A)^2)) powr(1/2))^2"
+    by (metis of_nat_0_le_iff of_nat_power_eq_of_nat_cancel_iff power_mono)
+  then have "(card A)^4 \<le> (((C * (card A)) * ((\<Sum> x \<in> sumset A A. (f_sum x A)^2))) powr (1/2))^2"
+    by (smt (verit) assms of_nat_0_le_iff powr_mult
+      mult.left_commute power2_eq_square power3_eq_cube power4_eq_xxxx power_commutes)
+  then have "(card A)^4 \<le> (( C * (card A)) * ((\<Sum> x \<in> sumset A A. (f_sum x A)^2)))"
+    using assms powr_half_sqrt of_nat_0 of_nat_le_0_iff power_mult_distrib 
+      real_sqrt_pow2 by (smt (verit, best) powr_mult)
+  moreover have "additive_energy A =  (\<Sum> x \<in> sumset A A. (f_sum x A)^2)/ (card A)^3" 
+    using additive_energy_def f_sum_card_quadruple_set assms by simp
+  moreover then have "additive_energy A * (card A)^3 = (\<Sum> x \<in> sumset A A. (f_sum x A)^2)"
+    using assms by simp
+  ultimately have "(additive_energy A) \<ge> ((card A)^4)/ ( C * (card A)^4 )"
+    using additive_energy_upper_bound 
+      additive_abelian_group_axioms assms divide_le_eq divide_le_eq_1_pos mult.left_commute 
+      mult_left_mono of_nat_0_eq_iff of_nat_0_le_iff power_eq_0_iff power3_eq_cube power4_eq_xxxx 
+      linorder_not_less mult.assoc mult_zero_left of_nat_0_less_iff of_nat_mult 
+      order_trans_rules(23) times_divide_eq_right by (smt (verit) card_sumset_0_iff 
+      div_by_1 mult_cancel_left1 nonzero_mult_div_cancel_left nonzero_mult_divide_mult_cancel_right 
+      nonzero_mult_divide_mult_cancel_right2 of_nat_1 of_nat_le_0_iff times_divide_eq_left)
+   then show ?thesis by (simp add: assms)
+qed
+
+
+text\<open>An analogous version of Proposition 2.11 where the assumption is on a difference set is given 
+below. The proof is identical to the proof of @{term additive_energy_lower_bound_sumset}
+above (with the obvious modifications). \<close>
+
+proposition additive_energy_lower_bound_differenceset: fixes C::real
+  assumes "finite A" and "A \<subseteq> G" and "(card (differenceset A A)) \<le> C * card A" and "card A \<noteq> 0"
+  shows "additive_energy A \<ge> 1/C"
+
+proof-
+  have "(card A)^2 =  (\<Sum> x \<in> differenceset A A. real (f_diff x A))"
+   using assms f_diff_card by (metis of_nat_sum)
+  also have "... \<le> (card((differenceset A A)) powr (1/2)) * (\<Sum> x \<in> differenceset A A . (f_diff x A)^2) powr(1/2)"
+    using Cauchy_Schwarz_ineq_sum2[of "\<lambda> d. 1" "\<lambda> d. f_diff d A"] by auto
+  also have "...\<le> ((C * (card A))powr (1/2)) * ((\<Sum> x \<in> differenceset A A . (f_diff x A)^2)) powr(1/2)"
+    by (metis mult.commute mult_left_mono assms(3) of_nat_0_le_iff powr_ge_pzero powr_mono2 
+        zero_le_divide_1_iff zero_le_numeral)
+  finally have "((card A)^2)^2 \<le> (((C * (card A))powr (1/2)) * ((\<Sum> x \<in> differenceset A A . (f_diff x A)^2)) powr(1/2))^2"
+    by (metis of_nat_0_le_iff of_nat_power_eq_of_nat_cancel_iff power_mono)
+  then have "(card A)^4 \<le> (((C * (card A)) * ((\<Sum> x \<in> differenceset A A. (f_diff x A)^2))) powr (1/2))^2"
+    by (smt (verit) assms of_nat_0_le_iff powr_mult
+      mult.left_commute power2_eq_square power3_eq_cube power4_eq_xxxx power_commutes)
+  then have "(card A)^4 \<le> ((C * (card A)) * ((\<Sum> x \<in> differenceset A A . (f_diff x A)^2)))"
+    using assms powr_half_sqrt of_nat_0 of_nat_le_0_iff power_mult_distrib 
+      real_sqrt_pow2 by (smt (verit, best) powr_mult)
+  moreover have "additive_energy A =  (\<Sum> x \<in> differenceset A A. (f_diff x A)^2)/ (card A)^3" 
+    using additive_energy_def f_diff_card_quadruple_set assms by simp
+  moreover then have "additive_energy A * (card A)^3 = (\<Sum> x \<in> differenceset A A. (f_diff x A)^2)"
+    using assms by simp
+  ultimately have "(additive_energy A) \<ge> ((card A)^4)/ (C * (card A)^4 )"
+    using additive_energy_upper_bound 
+      additive_abelian_group_axioms assms divide_le_eq divide_le_eq_1_pos mult.left_commute 
+      mult_left_mono of_nat_0_eq_iff of_nat_0_le_iff power_eq_0_iff power3_eq_cube power4_eq_xxxx 
+      linorder_not_less mult.assoc mult_zero_left of_nat_0_less_iff of_nat_mult 
+      order_trans_rules(23) times_divide_eq_right by (smt (verit) card_sumset_0_iff 
+      div_by_1 mult_cancel_left1 nonzero_mult_div_cancel_left nonzero_mult_divide_mult_cancel_right 
+      nonzero_mult_divide_mult_cancel_right2 of_nat_1 of_nat_le_0_iff times_divide_eq_left)
+   then show ?thesis by (simp add: assms)
+qed
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Main_Proof.thy b/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Main_Proof.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Main_Proof.thy
@@ -0,0 +1,1268 @@
+section\<open>Towards the proof of the Balog--Szemer\'{e}di--Gowers Theorem\<close>
+
+(*
+  Session: Balog_Szemeredi_Gowers
+  Title:   Balog_Szemeredi_Gowers_Main_Proof.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds 
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Balog_Szemeredi_Gowers_Main_Proof
+  imports 
+    Prob_Space_Lemmas
+    Graph_Theory_Preliminaries
+    Sumset_Triangle_Inequality
+    Additive_Combinatorics_Preliminaries
+begin
+
+context additive_abelian_group
+
+begin
+
+text\<open>After having introduced all the necessary preliminaries in the imported files, we are now 
+ ready to follow the chain of the arguments for the main proof as in Gowers's notes \cite{Gowersnotes}.\<close>
+
+text\<open>The following lemma corresponds to Lemma 2.13 in Gowers's notes \cite{Gowersnotes}.\<close>
+
+lemma (in fin_bipartite_graph) proportion_bad_pairs_subset_bipartite: 
+  fixes c::real
+  assumes "c > 0"
+  obtains X' where "X' \<subseteq> X" and "card X' \<ge> density * card X / sqrt 2" and
+  "card (bad_pair_set X' Y c) / (card X')^2 \<le> 2 * c / density^2"
+proof (cases "density = 0") (* Edge case *)
+  case True
+  then show ?thesis using that[of "{}"] bad_pair_set_def by auto
+next
+  case False
+  then have dgt0: "density > 0" using density_simp by auto
+  let ?M = "uniform_count_measure Y"
+  interpret P: prob_space ?M
+    by (simp add: Y_not_empty partitions_finite prob_space_uniform_count_measure)
+  have sp: "space ?M = Y"
+    by (simp add: space_uniform_count_measure)
+  (* First show that the expectation of the size of X' is the average degree of a vertex *)
+  have avg_degree: "P.expectation (\<lambda> y . card (neighborhood y)) = density * (card X)"
+  proof -
+    have "density = (\<Sum>y \<in> Y . degree y)/(card X * card Y)"
+      using edge_size_degree_sumY density_simp by simp
+    then have d: "density * (card X) = (\<Sum>y \<in> Y . degree y)/(card Y)"
+      using card_edges_between_set edge_size_degree_sumY partitions_finite(1) partitions_finite(2) by auto 
+    have "P.expectation (\<lambda> y . card (neighborhood y)) = P.expectation (\<lambda> y . degree y)"
+      using alt_deg_neighborhood by simp
+    also have "... =(\<Sum> y \<in> Y. degree y)/(card Y)" using P.expectation_uniform_count
+      by (simp add: partitions_finite(2)) 
+    finally show ?thesis using d by simp
+  qed
+(* Conclude an inequality by Cauchy-Schwarz variation *)
+  then have card_exp_gt: "P.expectation (\<lambda> y. (card (neighborhood y))^2) \<ge> density^2 * (card X)^2"
+  proof - 
+    have "P.expectation (\<lambda> y. (card (neighborhood y))^2) \<ge> (P.expectation (\<lambda> y . card (neighborhood y)))^2" 
+      using P.cauchy_schwarz_ineq_var_uniform partitions_finite(2) by auto 
+    thus ?thesis using avg_degree
+      by (metis of_nat_power power_mult_distrib) 
+  qed
+(* Define our bad pair sets in this context *)
+  define B where "B \<equiv> bad_pair_set X Y c"
+  define B' where "B' \<equiv> \<lambda> y. bad_pair_set (neighborhood y) Y c"
+  have finB: "finite B" using bad_pair_set_finite partitions_finite B_def by auto
+  have "\<And> x. x \<in> X \<Longrightarrow> x \<in> V" using partitions_ss(1) by auto 
+  have "card B \<le> (card (X \<times> X))" using B_def bad_pair_set_ss partitions_finite 
+    card_mono finite_cartesian_product_iff by metis 
+  then have card_B: "card B \<le> (card X)^2"
+    by (metis card_cartesian_prod_square partitions_finite(1)) 
+  (* Find a bound on the probability of both x and x' belonging to X' *)
+  have "\<And> x x' . (x, x') \<in> B \<Longrightarrow> P.prob {y \<in> Y . {x, x'} \<subseteq> neighborhood y} < c"
+  proof -
+    fix x x' assume assm: "(x, x') \<in> B"
+    then have "x \<in> X" "x' \<in> X" unfolding B_def bad_pair_set_def bad_pair_def by auto
+    then have card_eq: "card {v \<in> V . vert_adj v x \<and> vert_adj v x'} = card {y \<in> Y. vert_adj y x \<and> vert_adj y x'}"
+      by (metis (no_types, lifting) X_vert_adj_Y vert_adj_edge_iff2 vert_adj_imp_inV) 
+    have ltc: "card {v \<in> V . vert_adj v x \<and> vert_adj v x'}/(card Y) < c" 
+      using assm by (auto simp add: B_def bad_pair_set_def bad_pair_def codegree_normalized_def codegree_def vert_adj_sym)
+    have "{y \<in> Y . {x, x'} \<subseteq> neighborhood y} = {y \<in> Y . vert_adj y x \<and> vert_adj y x'}"
+      using bad_pair_set_def bad_pair_def neighborhood_def vert_adj_imp_inV vert_adj_imp_inV by auto
+    then have "P.prob {y \<in> Y . {x, x'} \<subseteq> neighborhood y} = card {y \<in> Y. vert_adj y x \<and> vert_adj y x'}/ card Y"
+      using measure_uniform_count_measure partitions_finite(2) by fastforce 
+    thus "P.prob {y \<in> Y . {x, x'} \<subseteq> neighborhood y} < c" using card_eq ltc by simp
+  qed
+  then have "\<And> x x' . (x, x') \<in> B \<Longrightarrow> P.prob {y \<in> Y . (x, x') \<in> B' y} < c"
+    by (simp add: B_def B'_def bad_pair_set_def)
+  then have prob: "\<And> p .p \<in> B \<Longrightarrow> P.prob {y \<in> Y . indicator (B' y) p = 1} \<le> c"
+    unfolding indicator_def by fastforce   
+(* Conclude a bound on the expected number of bad pairs in X' *)
+  have dsimp: "(density^2 - (density^2/(2 * c)) * c) * (card X)^2 =(density^2/2) * (card X)^2" 
+    using assms by (simp add: algebra_simps)
+  then have gt0: "(density^2/2) * (card X)^2 > 0"
+    using dgt0 by (metis density_simp division_ring_divide_zero half_gt_zero linorder_neqE_linordered_idom
+          of_nat_less_0_iff of_nat_mult power2_eq_square zero_less_mult_iff)
+  have Cgt0: "(density^2/(2 * c)) > 0" using dgt0 assms by auto
+  have "\<And> y . y \<in> Y \<Longrightarrow> card (B' y) = (\<Sum> p \<in> B. indicator (B' y) p)"
+  proof -
+    fix y assume "y \<in> Y"
+    then have "neighborhood y \<subseteq> X" by (simp add: neighborhood_subset_oppY) 
+    then have ss: "B' y \<subseteq> B" unfolding B_def B'_def bad_pair_set_def 
+      using set_pairs_filter_subset by blast   
+    then show "card (B' y) = (\<Sum> p \<in> B. indicator (B' y) p)" 
+      using card_set_ss_indicator[of "B' y" "B"] finB by auto
+  qed
+  then have "P.expectation (\<lambda> y. card (B' y)) = P.expectation (\<lambda> y. (\<Sum> p \<in> B. indicator (B' y) p))"
+    by (metis (mono_tags, lifting) P.prob_space_axioms of_nat_sum partitions_finite(2) 
+        prob_space.expectation_uniform_count real_of_nat_indicator sum.cong)
+  also have "... = (\<Sum> p \<in> B . P.expectation (\<lambda> y. indicator (B' y) p))"
+    by (rule Bochner_Integration.integral_sum[of "B" ?M "\<lambda> p y . indicator (B' y) p"]) 
+      (auto simp add:  P.integrable_uniform_count_measure_finite partitions_finite(2))
+  finally have "P.expectation (\<lambda> y. card (B' y)) = (\<Sum> p \<in> B . P.prob {y \<in> Y. indicator (B' y) p = 1})"
+    using P.expectation_finite_uniform_indicator[of "Y" "B'"] using partitions_finite(2)
+    by (smt (verit, best) sum.cong)
+  then have "P.expectation (\<lambda> y. card (B' y)) \<le> (\<Sum> p \<in> B . c)" 
+    using prob sum_mono[of B "\<lambda> p. P.prob {y \<in> Y. indicator (B' y) p = 1}" "\<lambda> p. c"]
+    by (simp add: indicator_eq_1_iff) 
+  then have lt1: "P.expectation (\<lambda> y. card (B' y)) \<le> c * (card B)" using finB
+    by (simp add: mult_of_nat_commute)  
+(* State the inequality for any positive constant C *)
+  have "c * (card B) \<le> c * (card X)^2" using assms card_B by auto
+  then have "P.expectation (\<lambda> y. card (B' y)) \<le> c * (card X)^2"
+    using lt1 by linarith
+  then have "\<And> C. C> 0 \<Longrightarrow>  C * P.expectation (\<lambda> y. card (B' y)) \<le> C * c * (card X)^2"
+    by auto
+  then have "\<And> C . C> 0 \<Longrightarrow>(P.expectation (\<lambda> y. (card (neighborhood y))^2) - C * (P.expectation (\<lambda> y. card (B' y))) 
+      \<ge> (density^2 *(card X)^2) - (C*c*(card X)^2))" 
+    using card_exp_gt diff_strict1_mono by (smt (verit)) 
+  then have "\<And> C .C> 0 \<Longrightarrow> (P.expectation (\<lambda> y. (card (neighborhood y))^2) - C * (P.expectation (\<lambda> y. card (B' y))) 
+      \<ge> (density^2 - C * c) * (card X)^2)"
+    by (simp add: field_simps)
+(* Choose a value for C *)
+  then have "(P.expectation (\<lambda> y. (card (neighborhood y))^2) - (density^2/(2 * c)) * (P.expectation (\<lambda> y. card (B' y))) 
+      \<ge> (density^2 - (density^2/(2 * c)) * c) * (card X)^2)"
+    using Cgt0 assms by blast
+  then have "P.expectation (\<lambda> y. (card (neighborhood y))^2) - (density^2/(2 * c)) * (P.expectation (\<lambda> y. card (B' y)))
+       \<ge> (density^2/2) * (card X)^2" using dsimp by linarith
+  then have "P.expectation (\<lambda> y. (card (neighborhood y))^2) - (P.expectation (\<lambda> y. (density^2/(2 * c)) * card (B' y)))
+       \<ge> (density^2/2) * (card X)^2" by auto
+  then have "P.expectation (\<lambda> y. (card (neighborhood y))^2 - ((density^2/(2*c)) * card (B' y)))
+       \<ge> (density^2/2) * (card X)^2" 
+    using Bochner_Integration.integral_diff[of ?M "(\<lambda> y. (card (neighborhood y))^2)" "(\<lambda> y. (density^2/(2 * c)) * card (B' y))"]
+    P.integrable_uniform_count_measure_finite partitions_finite(2) by fastforce     
+      (* Obtain an X' with the required inequalities *)
+  then obtain y where yin: "y \<in> Y" and ineq: "(card (neighborhood y))^2 - ((density^2/(2 * c)) * card (B' y)) \<ge> (density^2/2) * (card X)^2"
+    using P.expectation_obtains_ge partitions_finite(2) by blast
+(* Show the result follows *)
+  let ?X' = "neighborhood y"
+  have ss: "?X' \<subseteq> X" 
+    using yin by (simp add: neighborhood_subset_oppY) 
+  have "local.density\<^sup>2 / (2 * c) * real (card (B' y)) \<ge> 0" 
+    using assms density_simp by simp 
+  then have d1: "(card ?X')^2 \<ge> (density^2/2) * (card X)^2" 
+    using ineq by linarith
+  then have "(card ?X') \<ge> sqrt(((density) * (card X))^2/2)"
+    by (simp add: field_simps real_le_lsqrt) 
+  then have den: "((card ?X') \<ge> (density * (card X)/(sqrt 2)))"
+    by (smt (verit, del_insts) divide_nonneg_nonneg divide_nonpos_nonneg real_sqrt_divide 
+        real_sqrt_ge_0_iff real_sqrt_unique zero_le_power2)
+  have xgt0: "(card ?X') > 0" using dgt0 gt0
+    using d1 gr0I by force (* long *)
+  then have "(card ?X')^2 \<ge> (density^2/(2 * c)) * card (B' y)"
+    using gt0 ineq by simp 
+  then have "(card ?X')^2/(density^2/(2 * c)) \<ge> card (B' y)" 
+    using Cgt0 by (metis mult.commute pos_le_divide_eq)
+  then have "((2 * c)/(density^2)) \<ge> card (B' y)/(card ?X')^2"  
+    using pos_le_divide_eq xgt0 by (simp add: field_simps)
+  thus ?thesis using that[of "?X'"] den ss B'_def by auto
+qed
+
+text\<open>The following technical probability lemma corresponds to Lemma 2.14 in Gowers's notes \cite{Gowersnotes}. \<close>
+
+lemma (in prob_space) expectation_condition_card_1: 
+  fixes X::"'a set"  and f::"'a \<Rightarrow> real" and \<delta>::real
+  assumes "finite X" and "\<forall> x \<in> X. f x \<le> 1" and "M = uniform_count_measure X" and "expectation f \<ge> \<delta>"
+  shows "card {x \<in> X. (f x \<ge> \<delta> / 2)} \<ge> \<delta> * card X / 2"
+proof (cases "\<delta> \<ge> 0")
+  assume h\<delta>: "\<delta> \<ge> 0"
+  have ineq1: "real (card (X - {x \<in> X. \<delta> \<le> f x * 2})) * \<delta> \<le> real (card X) * \<delta>" 
+    using card_mono assms Diff_subset h\<delta> mult_le_cancel_right nat_le_linear of_nat_le_iff 
+    by (smt (verit, best))
+  have ineq2: "\<forall> x \<in> X - {x. x \<in> X \<and> (f x \<ge> \<delta>/2)}. f x \<le> \<delta> / 2" by auto
+  have "expectation f * card X = (\<Sum>x \<in> X. f x)"
+    using assms(1) expectation_uniform_count assms(3) by force
+  also have "... = (\<Sum> x \<in>{x. x \<in> X \<and> (f x \<ge> \<delta>/2)}. f x) 
+    +(\<Sum> x \<in> X - {x. x \<in> X \<and> (f x \<ge> \<delta>/2)}. f x)"
+    using assms 
+    by (metis (no_types, lifting) add.commute mem_Collect_eq subsetI sum.subset_diff)
+  also have "... \<le> (\<Sum> x \<in>  {x. x \<in> X \<and> (f x \<ge> \<delta>/2)}. 1) + 
+    (\<Sum> x \<in> X - {x. x \<in> X \<and> (f x \<ge> \<delta>/2)} . \<delta> / 2)"
+    using assms sum_mono ineq2 by (smt (verit, ccfv_SIG) mem_Collect_eq)
+  also have "... \<le> card ({x. x \<in> X \<and> (f x \<ge> \<delta>/2)}) + (card X) * \<delta> / 2 "
+    using ineq1 by auto
+  finally have "\<delta> * card X \<le> card  {x. x \<in> X \<and> (f x \<ge> \<delta>/2)}+ (\<delta>/2)*(card X)"
+    using ineq1 mult_of_nat_commute assms(4) mult_right_mono le_trans
+    by (smt (verit, del_insts) of_nat_0_le_iff times_divide_eq_left)
+  then show ?thesis by auto
+next
+  assume "\<not> \<delta> \<ge> 0"
+  thus ?thesis by (smt (verit, del_insts) divide_nonpos_nonneg mult_nonpos_nonneg of_nat_0_le_iff)
+qed
+
+text\<open>The following technical probability lemma corresponds to Lemma 2.15 in Gowers's notes. \<close>
+
+lemma (in prob_space) expectation_condition_card_2:
+  fixes X::"'a set" and \<beta>::real and \<alpha>::real and f:: "'a \<Rightarrow> real"
+  assumes "finite X"  and "\<And> x. x \<in> X \<Longrightarrow> f x \<le> 1" and "\<beta> > 0" and "\<alpha> > 0"
+  and "expectation f \<ge> 1 - \<alpha>" and "M = uniform_count_measure X"
+  shows "card {x \<in> X. f x \<ge> 1 - \<beta>} \<ge> (1- \<alpha> / \<beta>) * card X"
+
+proof-
+  have hcard: "card {x \<in> X. 1 - \<beta> \<le> f x} \<le> card X" using card_mono assms(1) by fastforce
+  have h\<beta>: "\<forall> x \<in> X- {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}. f x \<le> 1 - \<beta>" by auto
+  have "expectation f * card X = (\<Sum> x \<in> X. f x)"
+    using assms(1) expectation_uniform_count assms(6) by force
+  then have "(1 - \<alpha>) * card X \<le> (\<Sum> x \<in> X. f x)" using assms
+    by (metis mult.commute sum_bounded_below sum_constant)
+  also have "... = (\<Sum> x \<in> {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}. f x) + 
+ (\<Sum> x \<in> X - {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}. f x)" using assms 
+    by (metis (no_types, lifting) add.commute mem_Collect_eq subsetI sum.subset_diff)
+  also have "... \<le>  (\<Sum> x \<in> {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}. 1) + 
+ (\<Sum> x \<in> X - {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}. (1 - \<beta>))"
+    using assms h\<beta> sum_mono by (smt (verit, ccfv_SIG) mem_Collect_eq)
+  also have "...  = card {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)} + (1-\<beta>) * card ( X- {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})"
+    by auto
+  also have "... = (card {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)} + 
+    card (X- {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})) - \<beta> * card (X -{x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})"
+    using left_diff_distrib
+    by (smt (verit, ccfv_threshold) mult.commute mult.right_neutral of_nat_1 of_nat_add of_nat_mult)
+  also have heq: "... = card X - \<beta> * card (X -{x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})" 
+    using assms(1) card_Diff_subset[of "{x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)}" "X"] hcard by auto
+  finally have "(1- \<alpha>) * card X \<le> card X - \<beta> * card ( X -{x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})" by blast
+  then have "- (1- \<alpha>) * card X + card X \<ge> \<beta> * card ( X -{x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})" by linarith
+  then have "- card X + \<alpha> * card X + card X \<ge> \<beta> * card(X - {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})"
+    using add.assoc add.commute
+    add.right_neutral add_0 add_diff_cancel_right' add_diff_eq add_uminus_conv_diff diff_add_cancel 
+    distrib_right minus_diff_eq mult.commute mult_1 of_int_minus of_int_of_nat_eq uminus_add_conv_diff
+    cancel_comm_monoid_add_class.diff_cancel by (smt (verit, del_insts) mult_cancel_right2)
+  then have "\<alpha> * card X \<ge> \<beta> * card(X - {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})" by auto
+  then have "\<alpha> * card X / \<beta> \<ge> card(X - {x. x \<in> X \<and> (f x \<ge> 1 - \<beta>)})" using assms
+    by (smt (verit, ccfv_SIG) mult.commute pos_divide_less_eq)
+  then show ?thesis by (smt (verit) heq combine_common_factor left_diff_distrib' mult_of_nat_commute
+    nat_mult_1_right of_nat_1 of_nat_add of_nat_mult times_divide_eq_left scale_minus_left)
+qed
+
+text\<open>The following lemma corresponds to Lemma 2.16 in Gowers's notes \cite{Gowersnotes}. For the proof, we will apply 
+Lemma 2.13 (@{term proportion_bad_pairs_subset_bipartite}, the technical probability Lemmas 2.14 
+(@{term expectation_condition_card_1}) and 2.15 (@{term expectation_condition_card_2}) as well 
+as background material on graphs with loops and bipartite graphs that was previously presented.  \<close>
+
+lemma (in fin_bipartite_graph) walks_of_length_3_subsets_bipartite: 
+  obtains X' and Y' where "X' \<subseteq> X" and "Y' \<subseteq> Y" and
+  "card X' \<ge> (edge_density X Y)^2 * card X / 16" and
+  "card Y' \<ge> edge_density X Y * card Y / 4" and
+  "\<forall> x \<in> X'. \<forall> y \<in> Y'. card {p. connecting_walk x y p \<and> walk_length p = 3} \<ge> 
+  (edge_density X Y)^6 * card X * card Y / 2^13"
+
+proof (cases "edge_density X Y > 0")
+  let ?\<delta> = "edge_density X Y"
+  assume h\<delta>: "?\<delta> > 0" 
+  interpret P1: prob_space "uniform_count_measure X"
+    by (simp add: X_not_empty partitions_finite(1) prob_space_uniform_count_measure)
+  have hP1exp: "P1.expectation (\<lambda> x. degree_normalized x Y) \<ge> ?\<delta>"
+    using P1.expectation_uniform_count partitions_finite sum_degree_normalized_X_density by auto
+  let ?X1 = "{x \<in> X. (degree_normalized x Y \<ge> ?\<delta>/2)}"
+  have hX1X: "?X1 \<subseteq> X" and hX1card: "card ?X1 \<ge> ?\<delta> * (card X)/2"
+    and hX1degree: "\<forall> x \<in> ?X1. degree_normalized x Y \<ge> ?\<delta> /2" using 
+      P1.expectation_condition_card_1 partitions_finite degree_normalized_le_1 hP1exp by auto
+  have hX1cardpos: "card ?X1 > 0" using hX1card h\<delta> X_not_empty
+    by (smt (verit, del_insts) divide_divide_eq_right divide_le_0_iff density_simp gr0I 
+        less_eq_real_def mult_is_0 not_numeral_le_zero of_nat_le_0_iff of_nat_less_0_iff)
+  interpret H: fin_bipartite_graph "(?X1 \<union> Y)" "{e \<in> E. e \<subseteq> (?X1 \<union> Y)}" "?X1" "Y"
+  proof (unfold_locales, simp add: partitions_finite)
+    have "disjoint {?X1, Y}" using hX1X partition_on_def partition
+      by (metis (no_types, lifting) disjnt_subset2 disjnt_sym ne pairwise_insert singletonD)
+    moreover have "{} \<notin> {?X1, Y}" using hX1cardpos Y_not_empty
+      by (metis (no_types, lifting) card.empty insert_iff neq0_conv singleton_iff)
+    ultimately show "partition_on (?X1 \<union> Y) {?X1, Y}" using partition_on_def by auto
+  next
+    show "?X1 \<noteq> Y" using ne partition by (metis Int_absorb1 Y_not_empty hX1X part_intersect_empty)
+  next
+    show "\<And>e. e \<in> {e \<in> E. e \<subseteq> ?X1 \<union> Y} \<Longrightarrow> e \<in> all_bi_edges {x \<in> X. edge_density X Y / 2 \<le> 
+      degree_normalized x Y} Y"
+      using Un_iff Y_verts_not_adj edge_betw_indiv in_mono insert_subset mem_Collect_eq 
+       subset_refl that vert_adj_def all_bi_edges_def[of "?X1" "Y"] in_mk_uedge_img_iff
+       by (smt (verit, ccfv_threshold) all_edges_betw_I all_edges_between_bi_subset)
+  next
+    show "finite (?X1 \<union> Y)" using hX1X by (simp add: partitions_finite(1) partitions_finite(2))
+  qed
+  have neighborhood_unchanged: "\<forall> x \<in> ?X1. neighbors_ss x Y = H.neighbors_ss x Y" 
+    using neighbors_ss_def H.neighbors_ss_def vert_adj_def H.vert_adj_def by auto
+  then have degree_unchanged: "\<forall> x \<in> ?X1. degree x = H.degree x" 
+    using H.degree_neighbors_ssX degree_neighbors_ssX by auto
+  have hHdensity: "(H.edge_density ?X1 Y) \<ge> ?\<delta> / 2" 
+  proof-
+    have "?\<delta> / 2 = (\<Sum> x \<in> ?X1. (?\<delta> / 2)) / card ?X1" using hX1cardpos by auto
+    also have "... \<le> (\<Sum> x \<in> ?X1. degree_normalized x Y) / card ?X1"
+      using sum_mono hX1degree  hX1cardpos divide_le_cancel
+      by (smt (z3) H.X_not_empty H.partitions_finite(1) 
+        calculation divide_pos_pos h\<delta> sum_pos zero_less_divide_iff)
+    also have "... = (H.edge_density ?X1 Y)" 
+      using H.degree_normalized_def degree_normalized_def degree_unchanged sum.cong
+        H.degree_neighbors_ssX degree_neighbors_ssX H.sum_degree_normalized_X_density by auto
+    finally show ?thesis by simp
+  qed
+  have h\<delta>3pos: "?\<delta>^3 / 128 > 0" using h\<delta> by auto
+  then obtain X2 where hX2subX1: "X2 \<subseteq> ?X1" and hX2card: "card X2 \<ge> (H.edge_density ?X1 Y) * 
+    (card ?X1)/ (sqrt 2)" and hX2badtemp: "(card (H.bad_pair_set X2 Y (?\<delta>^3 / 128))) / real ((card X2)^2)
+           \<le> 2 * (?\<delta>^3 / 128) / (H.edge_density ?X1 Y)^2" using H.proportion_bad_pairs_subset_bipartite
+    by blast
+  have "(H.edge_density ?X1 Y) * (card ?X1)/ (sqrt 2) > 0" using hHdensity hX1cardpos h\<delta> hX2card 
+    by auto
+  then have hX2cardpos: "card X2 > 0" using hX2card by auto
+  then have hX2finite: "finite X2" using card_ge_0_finite by auto
+  have hX2bad: "(card (H.bad_pair_set X2 Y (?\<delta>^3 / 128))) \<le> (?\<delta> / 16) * (card X2)^2"
+  proof-
+    have hpos: "real ((card X2)^2) > 0" using hX2cardpos by auto
+    have trivial: "(3:: nat) - 2 = 1" by simp
+    then have h\<delta>pow: "?\<delta> ^ 3 / ?\<delta> ^ 2 = ?\<delta>^1" using power_diff h\<delta>
+      by (metis div_greater_zero_iff less_numeral_extra(3) numeral_Bit1_div_2 zero_less_numeral) 
+    have "card (H.bad_pair_set X2 Y (?\<delta>^3 / 128)) \<le> (2 * (?\<delta>^3 / 128) / (H.edge_density ?X1 Y)^2) *
+      (card X2)^2" using hX2badtemp hX2cardpos by (simp add: field_simps)
+    also have "... \<le> (2 * (?\<delta>^3 / 128) / (?\<delta> / 2)^2) * (card X2)^2" 
+      using h\<delta> hHdensity divide_left_mono frac_le hpos by (smt (verit) divide_pos_pos 
+          edge_density_ge0 le_divide_eq power_mono zero_le_divide_iff zero_less_power)
+    also have "... = (?\<delta>^3 / ?\<delta>^2) * (1/16) * (card X2)^2" by (simp add: field_simps)
+    also have "... = (?\<delta> / 16) * (card X2) ^ 2" using h\<delta>pow by auto
+    finally show ?thesis by simp
+  qed
+  let ?E_loops = "mk_edge ` {(x, x') | x x'. x \<in> X2 \<and> x' \<in> X2 \<and> 
+    (H.codegree_normalized x x' Y) \<ge> ?\<delta> ^ 3 / 128}"
+  interpret \<Gamma>: ulgraph "X2" "?E_loops"
+  proof(unfold_locales)
+    show "\<And>e. e \<in> ?E_loops \<Longrightarrow> e \<subseteq> X2" by auto
+  next
+    have "\<And>a b. a \<in> X2 \<Longrightarrow> b \<in> X2 \<Longrightarrow> 0 < card {a, b}"
+      by (meson card_0_eq finite.emptyI finite_insert insert_not_empty neq0_conv)
+    moreover have "\<And> a b. a \<in> X2 \<Longrightarrow> b \<in> X2 \<Longrightarrow> card {a, b} \<le> 2"
+      by (metis card_2_iff dual_order.refl insert_absorb2 is_singletonI 
+          is_singleton_altdef one_le_numeral)
+    ultimately show "\<And>e. e \<in> ?E_loops \<Longrightarrow> 0 < card e \<and> card e \<le> 2" by auto
+  qed
+  have h\<Gamma>_edges: "\<And> a b. a \<in> X2 \<Longrightarrow> b \<in> X2 \<Longrightarrow> 
+      {a, b} \<in> ?E_loops \<longleftrightarrow> H.codegree_normalized a b Y \<ge> ?\<delta>^3/128"
+    proof
+      fix a b assume "{a, b} \<in> ?E_loops"
+      then show "H.codegree_normalized a b Y \<ge> ?\<delta>^3/128"
+        using in_mk_uedge_img_iff[of "a" "b" "{(x, x') | x x'. x \<in> X2 \<and> x' \<in> X2 \<and> 
+        (H.codegree_normalized x x' Y) \<ge> ?\<delta> ^ 3 / 128}"] doubleton_eq_iff H.codegree_normalized_sym 
+        by auto
+    next
+      fix a b assume "a \<in> X2" and "b \<in> X2" and "H.codegree_normalized a b Y \<ge> ?\<delta>^3/128"
+      then show "{a, b} \<in> ?E_loops" using in_mk_uedge_img_iff[of "a" "b" "{(x, x') | x x'. x \<in> X2 \<and> 
+        x' \<in> X2 \<and> (H.codegree_normalized x x' Y) \<ge> ?\<delta> ^ 3 / 128}"] H.codegree_normalized_sym by auto
+  qed
+  interpret P2: prob_space "uniform_count_measure X2"
+    using hX2finite hX2cardpos prob_space_uniform_count_measure by fastforce
+  have hP2exp: "P2.expectation (\<lambda> x. \<Gamma>.degree_normalized x X2) \<ge> 1 - ?\<delta> / 16"
+  proof-
+    have h\<Gamma>all: "\<Gamma>.all_edges_between X2 X2 = (X2 \<times> X2) - H.bad_pair_set X2 Y (?\<delta>^3 / 128)"
+    proof
+      show "\<Gamma>.all_edges_between X2 X2 \<subseteq> X2 \<times> X2 - H.bad_pair_set X2 Y (?\<delta> ^ 3 / 128)"
+      proof
+        fix x assume "x \<in> \<Gamma>.all_edges_between X2 X2"
+        then obtain a b where "a \<in> X2" and "b \<in> X2" and "x = (a, b)" and 
+          "H.codegree_normalized a b Y \<ge> ?\<delta>^3 / 128" 
+          using \<Gamma>.all_edges_between_def in_mk_uedge_img_iff h\<Gamma>_edges
+          by (smt (verit, del_insts) \<Gamma>.all_edges_betw_D3 \<Gamma>.wellformed_alt_snd edge_density_commute 
+              mk_edge.cases mk_edge.simps that)
+        then show "x \<in> X2 \<times> X2 - H.bad_pair_set X2 Y (?\<delta> ^ 3 / 128)" 
+          using H.bad_pair_set_def H.bad_pair_def by auto
+      qed
+    next
+      show "X2 \<times> X2 - H.bad_pair_set X2 Y (?\<delta> ^ 3 / 128) \<subseteq> \<Gamma>.all_edges_between X2 X2"
+        using H.bad_pair_set_def H.bad_pair_def \<Gamma>.all_edges_between_def h\<Gamma>_edges by auto
+    qed
+    then have h\<Gamma>all_le: "card (\<Gamma>.all_edges_between X2 X2) \<ge> (1 - ?\<delta> / 16) * (card X2 * card X2)" 
+    proof-
+      have hbadsub: "H.bad_pair_set X2 Y (?\<delta> ^3 / 128) \<subseteq> X2 \<times> X2" using H.bad_pair_set_def by auto
+      have "(1 - ?\<delta> / 16) * (card X2 * card X2) = card (X2 \<times> X2) - ?\<delta> / 16 * (card X2) ^2"
+        using card_cartesian_product power2_eq_square 
+        by (metis Rings.ring_distribs(4) more_arith_simps(6) mult_of_nat_commute)
+      also have "... \<le> card (X2 \<times> X2) - card (H.bad_pair_set X2 Y (?\<delta> ^ 3 / 128))" 
+        using hX2bad by auto
+      also have "... = card (X2 \<times> X2 - H.bad_pair_set X2 Y (?\<delta> ^ 3 / 128))" using card_Diff_subset 
+        finite_cartesian_product[of "X2" "X2"] hX2finite hbadsub 
+        by (metis (mono_tags, lifting) finite_subset)
+      finally show "card(\<Gamma>.all_edges_between X2 X2) \<ge> (1 - ?\<delta>/16) * (card X2 * card X2)"
+        using h\<Gamma>all by simp
+    qed
+    have "1 - ?\<delta> / 16 = ((1 - ?\<delta> / 16) * (card X2 * card X2)) / (card X2 * card X2)" 
+      using hX2cardpos by auto
+    also have "... \<le> card (\<Gamma>.all_edges_between X2 X2) / (card X2 * card X2)" 
+      using h\<Gamma>all_le hX2cardpos divide_le_cancel of_nat_less_0_iff by fast
+    also have "... = (\<Sum> x \<in> X2. real (card (\<Gamma>.neighbors_ss x X2))) / card X2 / card X2"
+      using \<Gamma>.card_all_edges_betw_neighbor[of "X2" "X2"] hX2finite by (auto simp add: field_simps)
+    also have "... = (\<Sum> x \<in> X2. \<Gamma>.degree_normalized x X2) / card X2"
+      unfolding \<Gamma>.degree_normalized_def 
+      using sum_divide_distrib[of "\<lambda> x. real (card (\<Gamma>.neighbors_ss x X2))" "X2" "card X2"] by auto
+    also have "... = P2.expectation (\<lambda> x. \<Gamma>.degree_normalized x X2)"
+      using P2.expectation_uniform_count hX2finite by auto
+    finally show ?thesis by simp
+  qed
+  let ?X' = "{x \<in> X2. \<Gamma>.degree_normalized x X2 \<ge> 1 - ?\<delta> / 8}"
+  have hX'subX2: "?X' \<subseteq> X2" by blast
+  have hX'cardX2: "card ?X' \<ge> card X2 / 2" using hX2finite divide_self h\<delta>
+    P2.expectation_condition_card_2 [of "X2" "(\<lambda> x. \<Gamma>.degree_normalized x X2)" "?\<delta> /8" "?\<delta> / 16"] 
+    hP2exp \<Gamma>.degree_normalized_le_1 by auto
+  interpret P3: prob_space "uniform_count_measure Y"
+    by (simp add: Y_not_empty partitions_finite(2) prob_space_uniform_count_measure)
+  have hP3exp: "P3.expectation (\<lambda> y. H.degree_normalized y X2) \<ge> ?\<delta> / 2"
+  proof-
+    have hHdegree_normalized: "\<And> x. x \<in> X2 \<Longrightarrow> (?\<delta> / 2) \<le> H.degree_normalized x Y"
+      using hX1degree degree_normalized_def  H.degree_normalized_def neighborhood_unchanged 
+        hX2subX1 subsetD by (metis (no_types, lifting))
+    have "?\<delta> / 2 = (\<Sum> x \<in> X2. (?\<delta> / 2)) / card X2" using hX2cardpos by auto
+    also have "... \<le> (\<Sum> x \<in> X2. real (card (H.neighbors_ss x Y))) / card Y / card X2" 
+      using hHdegree_normalized sum_mono divide_le_cancel hX2cardpos of_nat_0_le_iff
+        H.degree_normalized_def sum.cong sum_divide_distrib by (smt (verit, best))
+    also have "... = (card (H.all_edges_between Y X2)) / card X2 / card Y"
+      using H.card_all_edges_between_commute  H.card_all_edges_betw_neighbor hX2finite 
+        H.partitions_finite(2) by auto
+    also have "... = (\<Sum> y \<in> Y. real (card(H.neighbors_ss y X2))) / card X2 / card Y" using
+        H.card_all_edges_betw_neighbor hX2finite H.partitions_finite(2) by auto
+    also have "... = (\<Sum> y \<in> Y. H.degree_normalized y X2) / card Y" using H.degree_normalized_def 
+      sum.cong sum_divide_distrib by (smt (verit, best))
+    also have "... = P3.expectation (\<lambda> y. H.degree_normalized y X2)" 
+      using P3.expectation_uniform_count H.partitions_finite(2) by auto
+    finally show ?thesis by linarith
+  qed
+  let ?Y' = "{x \<in> Y. H.degree_normalized x X2 \<ge> ?\<delta> / 4}"
+  have hY'subY: "?Y' \<subseteq> Y" by blast
+  then have hY'card: "card ?Y' \<ge> ?\<delta>  * card Y / 4"
+    using P3.expectation_condition_card_1[of "Y" "(\<lambda> y. H.degree_normalized y X2)" "?\<delta> / 2"] H.partitions_finite(2) 
+      hP3exp H.degree_normalized_le_1 by auto
+
+  have hX2adjcard: "\<And> x y. x \<in> ?X' \<Longrightarrow> y \<in> ?Y' \<Longrightarrow> 
+    card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} \<ge> ?\<delta> / 8 * card X2"
+  proof-
+    fix x y assume hx: "x \<in> ?X'" and hy: "y \<in> ?Y'"
+    have hinter: "{x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} = 
+      {x' \<in> X2. \<Gamma>.vert_adj x x'} \<inter> {x' \<in> X2. vert_adj y x'}" by auto
+    have huncardX2: "card ({x' \<in> X2. \<Gamma>.vert_adj x x'} \<union> {x' \<in> X2. vert_adj y x'}) \<le> card X2" 
+      using card_mono hX2finite by fastforce
+    have fin1: "finite {x' \<in> X2. \<Gamma>.vert_adj x x'}" and fin2: "finite {x' \<in> X2. vert_adj y x'}"
+      using hX2finite by auto 
+    have "{x' \<in> X2. \<Gamma>.vert_adj x x'} = \<Gamma>.neighbors_ss x X2"
+    using \<Gamma>.vert_adj_def vert_adj_def \<Gamma>.neighbors_ss_def hX2subX1 \<Gamma>.neighbors_ss_def by auto
+    then have hcard1: "card {x' \<in> X2. \<Gamma>.vert_adj x x'} \<ge> (1 - ?\<delta>/8) * card X2" using hx 
+        \<Gamma>.degree_normalized_def divide_le_eq hX2cardpos by (simp add: hX2card le_divide_eq)
+    have "{x' \<in> X2. vert_adj y x'} = H.neighbors_ss y X2" using H.vert_adj_def vert_adj_def 
+      H.neighbors_ss_def hy hY'subY hX2subX1 H.neighbors_ss_def by auto
+    then have hcard2: "card {x' \<in> X2. vert_adj y x'} \<ge> (?\<delta> / 4) * card X2" 
+      using hy H.degree_normalized_def divide_le_eq hX2cardpos by (simp add: hX2card le_divide_eq)
+    have "?\<delta> / 8 * card X2 = (1 - ?\<delta> / 8) * card X2 + ?\<delta>/4 * card X2 - card X2" 
+      by (simp add: algebra_simps)
+    also have "... \<le> card {x' \<in> X2. \<Gamma>.vert_adj x x'} + card {x' \<in> X2. vert_adj y x'} -
+      card ({x' \<in> X2. \<Gamma>.vert_adj x x'} \<union> {x' \<in> X2. vert_adj y x'})" 
+      using huncardX2 hcard1 hcard2 by linarith
+    also have "... = card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}"
+      using card_Un_Int fin1 fin2 hinter by fastforce
+    finally show "card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} \<ge> ?\<delta> / 8 * card X2" 
+      by linarith
+  qed
+  have hYpos: "real (card Y) > 0" using Y_not_empty partitions_finite(2) by auto
+  have "\<And> x y. x \<in> ?X' \<Longrightarrow> y \<in> ?Y' \<Longrightarrow> card {p. connecting_walk x y p \<and> walk_length p = 3} \<ge> 
+    (?\<delta> ^ 3 / 128 * (card Y)) * ((?\<delta> / 8) * (card X2))"
+  proof-
+    fix x y assume hx: "x \<in> ?X'" and hy: "y \<in> ?Y'"
+    then have hxV: "x \<in> V" and hyV: "y \<in> V" using hY'subY hX'subX2 hX2subX1 hX1X partitions_ss(1)
+     partitions_ss(2) subsetD by auto
+    define f:: "'a \<Rightarrow> 'a list set" where "f \<equiv> (\<lambda> a. ((\<lambda> z. z @ [y]) ` {p. connecting_path x a p \<and> walk_length p = 2}))"
+    have h_norm: "\<And> a. a \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} \<Longrightarrow> codegree_normalized x a Y \<ge> ?\<delta>^3 / 128"
+      using \<Gamma>.vert_adj_def codegree_normalized_sym hx hX'subX2 subsetD 
+        codegree_normalized_altX H.codegree_normalized_altX neighborhood_unchanged 
+        h\<Gamma>_edges hX2subX1 hX1X by (smt (verit, del_insts) mem_Collect_eq)
+    have inj_concat: "inj (\<lambda> z. z @ [y])" using inj_def by blast                                       
+    then have card_f_eq: "\<And> a. card (f a) = card {p. connecting_path x a p \<and> walk_length p = 2}" 
+      using f_def card_image inj_eq by (smt (verit) inj_onI)
+    then have card_f_ge: "\<And> a. a \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} \<Longrightarrow> 
+      card (f a) \<ge> ?\<delta>^3 / 128 * card Y" 
+      using codegree_is_path_length_two codegree_normalized_def hYpos f_def h_norm by (simp add: field_simps)
+    have f_disjoint: "pairwise (\<lambda> s t. disjnt (f s) (f t)) {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}"
+    proof (intro pairwiseI)
+      fix s t assume "s \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}" and 
+        "t \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}" and "s \<noteq> t" 
+      moreover have "\<And> a l. l \<in> f a \<Longrightarrow> l ! 2 = a" 
+      proof-
+        fix a l assume "l \<in> f a"
+        then obtain z where hz: "z \<in> {p. connecting_path x a p \<and> walk_length p = 2}" and hlz: "l = z @ [y]" 
+          using f_def by blast
+        then have "z ! 2 = a" using walk_length_conv connecting_path_def last_conv_nth
+          by (metis (mono_tags, lifting) diff_add_inverse length_tl list.sel(2) mem_Collect_eq 
+            nat_1_add_1 one_eq_numeral_iff rel_simps(18))
+        then show "l ! 2 = a" using hlz nth_append hz walk_length_conv less_diff_conv mem_Collect_eq
+          by (metis (mono_tags, lifting) nat_1_add_1 one_less_numeral_iff rel_simps(9))
+      qed
+      ultimately show "disjnt (f s) (f t)" by (metis disjnt_iff)
+    qed
+    have hwalk_subset: "{p. connecting_walk x k p \<and> walk_length p = n} \<subseteq> {p. set p \<subseteq> V \<and> length p = n + 1}" for n k
+      using connecting_walk_def is_walk_def walk_length_conv by auto
+    have finite_walk: "finite {p. connecting_walk x k p \<and> walk_length p = n}" for n k
+      using finV finite_lists_length_eq finite_subset hwalk_subset[of "k" "n"] rev_finite_subset by blast
+    have f_finite: "\<And> A. A \<in> (f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}) \<Longrightarrow> finite A"
+    proof-
+      fix A assume "A \<in> (f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'})"
+      then obtain a where "a \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}" and hA: "A = f a" by blast
+      have "{p. connecting_path x a p \<and> walk_length p = 2} \<subseteq> {p. connecting_walk x a p \<and> walk_length p = 2}" 
+        using connecting_path_walk by blast
+      then have "finite {p. connecting_path x a p \<and> walk_length p = 2}" 
+        using finite_walk finite_subset connecting_path_walk by blast
+      then show "finite A" using f_def hA by auto
+    qed
+    moreover have f_image_sub: 
+      "(\<Union> x \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}. f x) \<subseteq> {p. connecting_walk x y p \<and> walk_length p = 3}"
+    proof(intro Union_least)
+      fix X assume "X \<in> f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}"
+      then obtain a where ha: "a \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}" and haX: "f a = X" by blast
+      have "\<And>z. connecting_path x a z \<Longrightarrow> walk_length z = 2 \<Longrightarrow> connecting_walk x y (z @ [y])"
+      proof-
+        fix z assume hpath: "connecting_path x a z" and hlen: "walk_length z = 2" 
+        then obtain y' where "z ! 1 = y'" by blast
+        then have hz: "z = [x, y', a]" using list2_middle_singleton walk_length_conv 
+          connecting_path_def hpath hlen add_diff_cancel_left' append_butlast_last_id
+          butlast.simps connecting_path_walk connecting_walk_def diff_diff_add diff_le_self 
+          is_walk_not_empty is_walk_tl last_ConsL last_tl list.expand list.sel list.simps(3) 
+          nat_1_add_1 le_imp_diff_is_add 
+          by (metis (no_types, lifting) arith_simps(45) arithmetic_simps(2) numerals(1))
+        moreover have hwalk: "connecting_walk x a z" using connecting_path_walk hpath by blast
+        then show "connecting_walk x y (z @ [y])" using connecting_walk_def is_walk_def 
+          connecting_path_def is_gen_path_def is_walk_def ha hz hwalk hyV vert_adj_sym vert_adj_def by auto
+      qed
+      then show "X \<subseteq> {p. connecting_walk x y p \<and> walk_length p = 3}"
+        using haX f_def walk_length_conv by auto
+    qed
+    ultimately have hUn_le: "card (\<Union> x \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}. f x) \<le> card {p. connecting_walk x y p \<and> walk_length p = 3}"
+      using card_mono finite_walk[of "y" "3"] by blast
+    have "disjoint (f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'})" using f_disjoint pairwise_def
+        pairwise_image[of "disjnt" "f" "{x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}"] by (metis (mono_tags, lifting))
+    then have "card (\<Union> (f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'})) = sum card (f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'})" 
+      using card_Union_disjoint[of "f ` {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}"] f_finite by blast
+    also have "... = (\<Sum> a \<in> {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}. card (f a))" 
+      using sum_card_image[OF _ f_disjoint] hX2finite finite_subset by fastforce
+    also have "... \<ge> card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} * ?\<delta>^3 / 128 * card Y" 
+      using sum_mono[of "{x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'}" "(\<lambda> a. ?\<delta>^3 / 128 * card Y)" "(\<lambda> a. card (f a))"] 
+        card_f_ge by auto
+    finally have "card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} * ?\<delta>^3 / 128 * card Y \<le> card {p. connecting_walk x y p \<and> walk_length p = 3}"
+      using hUn_le by linarith
+    then have "(?\<delta> ^ 3 / 128 * (card Y)) * card {x' \<in> X2. \<Gamma>.vert_adj x x' \<and> vert_adj y x'} \<le> card {p. connecting_walk x y p \<and> walk_length p = 3}"
+      by argo
+    then show "(?\<delta> ^ 3 / 128 * (card Y)) * ((?\<delta> / 8) * (card X2)) \<le> card {p. connecting_walk x y p \<and> walk_length p = 3}" 
+      using hX2adjcard[OF hx hy] hYpos mult_left_mono h\<delta>3pos mult_pos_pos
+      by (smt (verit, del_insts))
+  qed
+  moreover have hX2cardX: "card X2 \<ge> (?\<delta> ^2 / 8) *(card X)" 
+  proof-
+    have "card X2 \<ge> (H.edge_density ?X1 Y / sqrt 2) * (card ?X1)" 
+      using hX2card by (simp add: algebra_simps)
+    moreover have "(H.edge_density ?X1 Y / sqrt 2) * (card ?X1) \<ge> (?\<delta> / (2 * sqrt 2)) * card ?X1" 
+      using hHdensity hX1cardpos by (simp add: field_simps)
+    moreover have "(?\<delta> / (2 * sqrt 2)) * card ?X1 \<ge> (?\<delta> / 4) * card ?X1" 
+      using sqrt2_less_2 hX1cardpos h\<delta> by (simp add: field_simps)
+    moreover have "(?\<delta> / 4) * card ?X1 \<ge> (?\<delta> / 4) * (?\<delta> / 2 * card X)" 
+      using hX1card h\<delta> by (simp add: field_simps)
+    moreover have "(?\<delta> / 4) * (?\<delta> / 2 * card X) = (?\<delta> ^2 / 8) *(card X)" using power2_eq_square
+      by (metis (no_types, opaque_lifting) Groups.mult_ac(2) Groups.mult_ac(3) divide_divide_eq_left
+      num_double numeral_times_numeral times_divide_eq_left times_divide_eq_right)
+    ultimately show ?thesis by linarith
+  qed
+  moreover have "(?\<delta> ^ 3 / 128 * (card Y)) * ((?\<delta> / 8) * (card X2)) \<ge> 
+    ?\<delta> ^ 6 * card X * card Y / 2 ^ 13" 
+  proof-
+    have hinter: "(?\<delta> / 8) * (?\<delta> ^2 / 8 * card X) \<le> (?\<delta> / 8) * (card X2)" 
+      using hX2cardX h\<delta> by (simp add: algebra_simps)
+    have "?\<delta> ^ 6 * real (card X * card Y) / 2 ^ 13  = 
+      ?\<delta> ^ 3 * ?\<delta> * ?\<delta> ^ 2 * real (card X * card Y) / (128 * 8 * 8)" by algebra
+    also have "... = (?\<delta> ^ 3 / 128 * (card Y)) * ((?\<delta> / 8) * (?\<delta> ^2 / 8 * card X))" by auto
+    also have "... \<le> (?\<delta> ^ 3 / 128 * (card Y)) * ((?\<delta> / 8) * (card X2))" 
+      using hinter hYpos h\<delta> power3_eq_cube
+      by (smt (verit) \<open>0 < edge_density X Y ^ 3 / 128\<close> mult_left_mono zero_compare_simps(6))
+    finally show ?thesis by simp
+  qed
+  moreover have hX'card: "card ?X' \<ge> ?\<delta> ^ 2 * card X / 16" using hX'cardX2 hX2cardX by auto
+  moreover have hX'subX: "?X' \<subseteq> X" using hX'subX2 hX2subX1 hX1X by auto
+  ultimately show ?thesis using hY'card hX'card hY'subY hX'subX that
+    by (smt (verit, best))
+next
+  assume "\<not> 0 < edge_density X Y"
+  then have "edge_density X Y = 0" by (smt (verit, ccfv_threshold) edge_density_ge0)
+  then show "?thesis" using that by auto
+qed
+
+
+text\<open>The following lemma corresponds to Lemma 2.17 in Gowers's notes \cite{Gowersnotes}. \<close>
+
+text\<open> Note that here we have set(@{term "additive_energy A = 2 * c"} (instead of 
+(@{term "additive_energy A = c"} as in the notes) and we are accordingly considering c-popular 
+differences (instead of c/2-popular differences as in the notes) so that we will still have 
+(@{term "\<theta> = additive_energy A / 2"}.\<close>
+
+lemma popular_differences_card:  fixes A::"'a set" and c::real
+  assumes "finite A" and "A \<subseteq> G" and "additive_energy A = 2 * c"
+  shows "card (popular_diff_set c A) \<ge> c * card A"  
+  (* typo in the notes, square must not be there *)
+
+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> (differenceset A A). (f_diff d A)^2)" 
+    using assms f_diff_card_quadruple_set_additive_energy by auto
+  also have "...= ((\<Sum>d \<in> (popular_diff_set c A). (f_diff d A)^2))
+    +((\<Sum> d \<in> ((differenceset A A) - (popular_diff_set c A)). (f_diff d A)^2))" 
+    using popular_diff_set_def assms finite_minusset finite_sumset by (metis (no_types, lifting) 
+      add.commute mem_Collect_eq subsetI sum.subset_diff)
+  also have "... \<le> ((card (popular_diff_set c A)) * (card A)^2)
+    + c * card A * ((\<Sum>d \<in> (differenceset A A - (popular_diff_set c A)) . (f_diff d A)))" 
+  proof-
+    have "\<forall> d \<in> ((differenceset A A) - (popular_diff_set c A)) . (f_diff d A)^2 \<le> 
+      (c * (card A)) * (f_diff d A)"
+    proof
+     fix d assume hd1: "d \<in> differenceset A A - popular_diff_set c A"
+     have hnonneg: "f_diff d A \<ge> 0" by auto
+     have "\<not> popular_diff d c A" using hd1 popular_diff_set_def by blast
+     from this have "f_diff d A \<le> c * card A" using popular_diff_def by auto
+     thus "real ((f_diff d A)\<^sup>2) \<le> c * real (card A) * real (f_diff 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> (differenceset A A) . f_diff d A \<le> (card A)^2" 
+     using f_diff_def finite_minusset finite_sumset assms
+     by (metis f_diff_le_card le_antisym nat_le_linear power2_nat_le_imp_le)
+   ultimately have "((\<Sum>d \<in> ((differenceset A A) - popular_diff_set c A) . (f_diff d A)^2)) \<le> 
+     ((\<Sum>d \<in> ((differenceset A A) - popular_diff_set c A). (c * card A) * (f_diff d A)))"
+     using assms finite_minusset finite_sumset sum_distrib_left sum_mono by fastforce
+   then have "((\<Sum>d \<in> ((differenceset A A) - popular_diff_set c A) . (f_diff d A)^2)) \<le>  
+     (c * card A) * ((\<Sum>d \<in> ((differenceset A A) - popular_diff_set c A) . (f_diff d A)))"
+     by (metis (no_types) of_nat_sum sum_distrib_left)
+   moreover have "(\<Sum>d \<in> popular_diff_set c A. (f_diff d A)^2) \<le> 
+    (\<Sum>d \<in> popular_diff_set c A. (card A)^2)" using f_diff_le_card assms sum_mono assms popular_diff_set_def
+     by (metis (no_types, lifting) power2_nat_le_eq_le)
+   moreover then have ddd: "(\<Sum>d \<in> popular_diff_set c A . (f_diff d A)^2) \<le> 
+    (card (popular_diff_set c A)) * (card A)^2" 
+    using sum_distrib_right by simp
+    ultimately show ?thesis by linarith
+  qed
+  also have "...  \<le> ((card (popular_diff_set c A)) * (card A)^2) + (c * card A) * (card A)^2" 
+  proof-
+    have "(\<Sum>d \<in> (differenceset A A - popular_diff_set c A) . (f_diff d A)) \<le>
+      (\<Sum>d \<in> differenceset A A . (f_diff d A))" using DiffD1 subsetI assms sum_mono2 
+      finite_minusset finite_sumset zero_le by metis
+    then have "(c * card A) * ((\<Sum>d \<in> (differenceset A A - popular_diff_set c A). (f_diff d A))) 
+      \<le> (c * card A) * (card A)^2" 
+      using f_diff_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_diff_set c A)) * (card A)^2) + 
+    (c * card A) * (card A)^2" by linarith
+  then have "(card (popular_diff_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 lemma corresponds to Lemma 2.18 in Gowers's notes \cite{Gowersnotes}. It includes the key argument
+of the main proof and its proof applies Lemmas 2.16 (@{term walks_of_length_3_subsets_bipartite})
+and 2.17 (@{term popular_differences_card}). In the proof we will use an appropriately defined
+bipartite graph as an intermediate/auxiliary construct so as to apply lemma 
+@{term walks_of_length_3_subsets_bipartite}. As each vertex set of the bipartite graph is constructed
+to be a copy of a finite subset of an Abelian group, we need flexibility regarding types, which is 
+what prompted the introduction and use of the new graph theory library \cite{Undirected_Graph_Theory-AFP} (that does not impose any type 
+restrictions e.g. by representing vertices as natural numbers). \<close>
+
+lemma obtains_subsets_differenceset_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 (differenceset A' B) \<le> 2^13 * card A / c^15"
+
+proof-
+  let ?X = "A \<times> {0:: nat}" (* Is this the best way to tag? *)
+  let ?Y = "A \<times> {1:: nat}"
+  let ?E = "mk_edge ` {(x, y)| x y. x \<in> ?X \<and> y \<in> ?Y \<and> (popular_diff (fst y \<ominus> 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_diff (y \<ominus> 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_diff (b \<ominus> 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 \<ominus> a = x})"
+    have f_disj: "pairwise (\<lambda> s t. disjnt (f s) (f t)) (popular_diff_set c A)" 
+    proof (intro pairwiseI)
+      fix x y assume hx: "x \<in> popular_diff_set c A" and hy: "y \<in> popular_diff_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 \<ominus> z = x" using f_def hx by (simp add: doubleton_eq_iff)
+          moreover have "w \<ominus> 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_diff_set c A. (f d) \<subseteq> ?E"
+      using popular_diff_set_def f_def edges1 by auto
+    have f_union_sub: "(\<Union> d \<in> popular_diff_set c A. (f d)) \<subseteq> ?E" using popular_diff_set_def 
+      f_def edges1 by auto
+    have f_disj2: "disjoint (f ` (popular_diff_set c A))" using f_disj 
+      pairwise_image[of "disjnt" "f" "popular_diff_set c A"] by (simp add: pairwise_def) 
+    have f_finite: "\<And>B. B \<in> f ` popular_diff_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_diff_set c A. card (f d) = f_diff d A"
+    proof
+      fix d assume "d \<in> popular_diff_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 \<ominus> 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 \<ominus> b = d}" and 
+          "y \<in> {(a, b) |a b. a \<in> A \<and> b \<in> A \<and> a \<ominus> 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 \<ominus> b = d} = f d" using f_def g_def by auto
+      show "card (f d) = f_diff d A" using card_image g_inj g_image f_diff_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_diff_set c A)) * (c * (card A))" 
+      using assms popular_differences_card hA by force  
+    also have "... \<le> (\<Sum> d \<in> popular_diff_set c A. f_diff d A)" using sum_mono popular_diff_set_def
+      popular_diff_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_diff_set c A. card (f d))"
+      using card_eq_f_diff sum.cong by auto
+    also have "... = sum card (f ` (popular_diff_set c A))"
+      using f_disj sum_card_image[of "popular_diff_set c A" "f"] popular_diff_set_def 
+        finite_minusset finite_sumset assms(1) finite_subset by auto
+    also have "... = card (\<Union> d \<in> popular_diff_set c A. (f d))"
+      using card_Union_disjoint[of "f ` (popular_diff_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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and>
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and>
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+        popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and>
+          popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> w) c A}"
+        then obtain z w where hz: "z \<in> A" and hw: "w \<in> A" and hzx: "popular_diff (z \<ominus> x) c A" and 
+          hzw: "popular_diff (z \<ominus> w) c A" and hyw: "popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> 
+          popular_diff (y \<ominus> 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_diff ((fst (p!1)) \<ominus> x) c A" using edges1 h1 hxp h1p hxA h1A
+            by (smt (z3))
+          have hpop2: "popular_diff((fst (p!1)) \<ominus> (fst (p!2))) c A" using edges1 h2 h1p h2p h1A h2A
+            by (smt (z3))
+          have hpop3: "popular_diff (y \<ominus> (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_diff (z \<ominus> x) c A \<and>
+            popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+        popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+        popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> w) c A} \<ge> c ^ 12 * ((card A)^2) / 2 ^ 13"
+        using hx1 hy2 card_walks by auto
+  qed
+  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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w} \<ge> c^3 * card A^3"
+  proof (auto)
+    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_diff (z \<ominus> x) c A" and 2: "popular_diff (z \<ominus> w) c A" and 
+      3: "popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w} = 
+      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x} \<times> 
+      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w} \<times> 
+      {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = y \<ominus> w}" using f_def by force  (*slow *)
+    have "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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w} = card ({(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x} \<times>
+      {(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w} \<times> {(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = y \<ominus> w})" 
+      using card_image f_inj f_image by fastforce
+    moreover have "card ({(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x} \<times>
+      {(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w} \<times> {(p, q). p \<in> A \<and> q \<in> A \<and> p \<ominus> q = y \<ominus> w}) =
+      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x} *
+      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w} * 
+      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = y \<ominus> w}"
+      using card_cartesian_product3 by auto
+    moreover have "c * card A \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x}" 
+      using 1 popular_diff_def f_diff_def by auto
+    moreover then have "(c * card A) * (c * card A) \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x}
+      * card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w}" 
+      using 2 popular_diff_def f_diff_def mult_mono assms(2) mult_nonneg_nonneg 
+        of_nat_0_le_iff of_nat_mult by fastforce
+    moreover then have "(c * card A) * (c * card A) * (c * card A) \<le> card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> x}
+      * card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = z \<ominus> w} * 
+      card {(p, q) | p q. p \<in> A \<and> q \<in> A \<and> p \<ominus> q = y \<ominus> w}"
+      using 3 popular_diff_def f_diff_def mult_mono assms(2) mult_nonneg_nonneg of_nat_0_le_iff 
+      of_nat_mult by fastforce
+    moreover have "c ^ 3 * card A ^ 3 = (c * card A) * ((c * card A) * (c * card A))" 
+      by (simp add: power3_eq_cube algebra_simps)
+    ultimately 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w})" by auto
+  qed
+  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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w})"
+    have h_pairwise_disjnt: "pairwise (\<lambda> a b. disjnt (?f a) (?f b)) 
+      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and>
+      popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+       popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> w) c A}" "b \<in> {(z, w) |z w. z \<in> A \<and> w \<in> A \<and>
+       popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = a1 \<ominus> x" and 
+          htu1: "t \<ominus> u = y \<ominus> a2" and hpq2: "p \<ominus> q = b1 \<ominus> x" and htu2: "t \<ominus> u = y \<ominus> b2" 
+          using ha hb by auto
+        then have "y \<ominus> a2 = y \<ominus> b2" using htu1 htu2 by auto
+        then have 2: "a2 = b2" using ha2 hb2 hyG 
+          by (metis additive_abelian_group.inverse_closed additive_abelian_group_axioms 
+            invertible invertible_inverse_inverse 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w}) ` 
+      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and>
+      popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w}) ` 
+        {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and>
+        popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w}) ` 
+      {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and>
+      popular_diff (y \<ominus> w) c A})" using h_pairwise_disjnt 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w})" 
+      "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and>
+      popular_diff (y \<ominus> w) c A}"] by (simp add: pairwise_def)
+    have "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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_diff (z \<ominus> x) c A \<and>
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> w) c A})"
+      using sum_card_image[of "{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> w) c A}" "?f"] h_pairwise_disjnt hwalks_finite by auto
+    also have "... = card (\<Union> (z, w)\<in>{(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and>
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> 
+      t \<ominus> u = y \<ominus> w})" using card_Union_disjoint hfinite_walks hdisj 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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> 
+     popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w}))" by simp
+  qed
+  have hdsub: "\<forall> d \<in> differenceset ?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_diff (z \<ominus> x) c A \<and> 
+    popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> u}"
+  proof
+    fix d assume "d \<in> differenceset ?C ?B"
+    then obtain y x where hy: "y \<in> ?C" and hx: "x \<in> ?B" and hxy: "d = y \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> 
+      t \<ominus> u = y \<ominus> w}) ` {(z, w) |z w. z \<in> A \<and> w \<in> A \<and> popular_diff (z \<ominus> x) c A \<and> 
+      popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> w}"
+        then obtain p q r s t u where "p \<ominus> q = z \<ominus> x" and "r \<ominus> s = z \<ominus> w" and "t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> u = (z \<ominus> x) \<ominus> (z \<ominus> w) \<oplus> (y \<ominus> w)"
+          by (smt (z3) additive_abelian_group.inverse_closed additive_abelian_group_axioms assms(4)
+          associative commutative_monoid.commutative commutative_monoid_axioms composition_closed
+          invertible invertible_inverse_inverse monoid.inverse_composition_commute monoid_axioms subsetD)
+        also have "... = (w \<ominus> x) \<oplus> (y \<ominus> w)" using hxG hyG hzG hwG associative commutative 
+          inverse_composition_commute invertible_right_inverse2 by auto
+        also have "... = y \<ominus> x" using hxG hwG hyG associative commutative
+          by (simp add: monoid.invertible_right_inverse2 monoid_axioms)
+        finally have "p \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> u = d" 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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_diff (z \<ominus> x) c A \<and> popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> u}" 
+      using hx hy by meson
+  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
+  moreover have "\<forall> d \<in> differenceset ?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 \<ominus> q \<ominus> r \<oplus>  s \<oplus>  t \<ominus> u)} \<ge> c ^ 15 * (card A) ^ 5 / 2 ^13"
+  proof
+    fix d assume "d \<in> differenceset ?C ?B"
+    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_diff (z \<ominus> x) c A \<and> 
+    popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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_diff (z \<ominus> x) c A \<and> 
+    popular_diff (z \<ominus> w) c A \<and> popular_diff (y \<ominus> 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 \<ominus> q = z \<ominus> x \<and> r \<ominus> s = z \<ominus> w \<and> t \<ominus> u = y \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> 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 \<ominus> q \<ominus> r \<oplus>  s \<oplus>  t \<ominus> 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 \<ominus> q \<ominus> r \<oplus>  s \<oplus>  t \<ominus> u)}) t)) (differenceset ?C ?B)" 
+    unfolding disjnt_def by (intro pairwiseI) (auto)
+  moreover have "\<forall> d \<in> differenceset ?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 \<ominus> q \<ominus> r \<oplus>  s \<oplus>  t \<ominus> u)}) d) \<subseteq> A \<times> A \<times> A \<times> A \<times> A \<times> A"
+    by blast
+  ultimately have "card (differenceset ?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 \<ominus> q \<ominus> r \<oplus> s \<oplus> t \<ominus> u)})" "differenceset ?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 (differenceset ?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
+
+
+text\<open>We now show the main theorem, which is a direct application of lemma  
+@{term obtains_subsets_differenceset_card_bound} and the Ruzsa triangle inequality.
+(The main theorem corresponds to Corollary 2.19 in Gowers's notes \cite{Gowersnotes}.) \<close>
+
+theorem Balog_Szemeredi_Gowers: fixes A::"'a set" and c::real
+  assumes afin: "finite A" and "A \<noteq> {}" and "c>0" and "additive_energy A = 2 * c" and ass: "A \<subseteq> G"
+  obtains A' where "A' \<subseteq> A" and "card A' \<ge> c^2 * card A / 4" and
+    "card (differenceset A' A') \<le>  2^30 * card A / c^34"
+proof-
+  obtain B and A' where bss: "B \<subseteq> A" and bne: "B \<noteq> {}" and bge: "card B \<ge> (c^4) * (card A)/16"
+    and a2ss: "A' \<subseteq> A"  and a2ge: "card A' \<ge> (c^2) * (card (A))/4"
+    and hcardle: "card (differenceset A' B) \<le> 2^13 * card A / c^15" 
+    using assms obtains_subsets_differenceset_card_bound by metis
+  have Bg0: "(card B :: real) > 0" using bne afin bss infinite_super by fastforce
+  have "(card  B) * card (differenceset A' A') \<le> 
+    card (differenceset A' B) * card (differenceset A' B)"
+    using afin a2ss bss infinite_super ass Ruzsa_triangle_ineq1 card_minusset' differenceset_commute
+      sumset_subset_carrier subset_trans sumset_commute by (smt (verit, best))
+  then have "card B * card (differenceset A' A') \<le> (card (differenceset A' B))^2"
+    using bss bss power2_eq_square by metis
+  then have "(card (differenceset A' A')) \<le> (card (differenceset A' B))^2/card B"  
+    using Bg0 nonzero_mult_div_cancel_left[of "card B" "card(differenceset A' A')"]
+      divide_right_mono by (smt (verit) of_nat_0 of_nat_mono real_of_nat_div4)
+  moreover have "(card (differenceset A' B))^2  \<le> ((2^13) * (1/c^15)*(card A))^2"  
+    using hcardle  by simp
+  ultimately have "(card (differenceset A' A')) \<le> ((2^13) * (1/c^15)*(card A))^2/(card B)" 
+    using pos_le_divide_eq[OF Bg0] by simp
+  moreover have "(c^4) * (card A)/16 >0" 
+    using assms card_0_eq by fastforce
+  moreover have "((2^13) * (1/c^15) * (card A))^2/(card B) = 
+    ((2^13)* (1/c^15)*(card A))^2 * (1/(card B))" by simp
+  moreover have "((2^13)* (1/c^15) * (card A))^2 * (1/(card B)) \<le> 
+    ((2^13) * (1/c^15) * (card A))^2/ ((c^4) * (card A)/16)" 
+    using bge calculation(2, 3) frac_le less_eq_real_def zero_le_power2 by metis 
+  ultimately have "(card (differenceset A' A')) \<le> ((2^13) * (1/c^15) * (card A))^2/ ((c^4) * (card A)/16)" 
+    by linarith
+  then have "(card (differenceset A' A')) \<le> (2^30) * (card A)/(c^34)" 
+    using card_0_eq assms by (simp add: power2_eq_square)
+  then show ?thesis using a2ss a2ge that by blast
+qed 
+
+text\<open>The following is an analogous version of the Balog--Szemer\'{e}di--Gowers 
+Theorem for a sumset instead of a difference set. The proof is similar to that of the original
+version, again using @{term obtains_subsets_differenceset_card_bound}, however, instead
+of the Ruzsa triangle inequality we will use the alternative triangle inequality for sumsets  
+@{term triangle_ineq_sumsets}. \<close>
+
+theorem Balog_Szemeredi_Gowers_sumset: fixes A::"'a set" and c::real
+  assumes afin: "finite A" and "A \<noteq> {}" and "c>0" and "additive_energy A = 2 * c" and ass: "A \<subseteq> G"
+  obtains A' where "A' \<subseteq> A" and "card A' \<ge> c^2 * card A / 4" and 
+    "card (sumset A' A') \<le> 2^30 * card A / c^34"
+
+proof-
+  obtain B and A' where bss: "B \<subseteq> A" and bne: "B \<noteq> {}" and bge: "card B \<ge> (c^4) * (card A)/16"
+    and a2ss: "A' \<subseteq> A"  and a2ne: "A' \<noteq> {}" and a2ge: "card A' \<ge> (c^2) * (card (A))/4"
+    and hcardle: "card (differenceset A' B) \<le> 2^13 * card A / c^15" 
+    using assms obtains_subsets_differenceset_card_bound by metis
+  have finA': "finite A'" and finB: "finite B" using afin a2ss bss using infinite_super by auto
+  have bg0: "(card B :: real) > 0" using bne afin bss infinite_super by fastforce
+  have "card (minusset B) * card (sumset A' A') \<le> 
+    card (sumset (minusset B) A') * card (sumset (minusset B) A')"
+    using finA' finB ass a2ss bss triangle_ineq_sumsets 
+    finite_minusset minusset_subset_carrier subset_trans by metis
+  then have "card B * card (sumset A' A') \<le> (card (differenceset A' B))^2"
+    using card_minusset bss ass power2_eq_square
+    by (metis card_minusset' subset_trans sumset_commute)
+  then have "(card (sumset A' A')) \<le> (card (differenceset A' B))^2/card B"  
+    using bg0 nonzero_mult_div_cancel_left[of "card B" "card(sumset A' A')"]
+      divide_right_mono by (smt (verit) of_nat_0 of_nat_mono real_of_nat_div4)
+  moreover have "(card (differenceset A' B))^2  \<le> ((2^13) * (1/c^15) * (card A))^2"  
+    using hcardle  by simp
+  ultimately have "(card (sumset A' A')) \<le> ((2^13) * (1/c^15) * (card A))^2/(card B)" 
+    using pos_le_divide_eq[OF bg0] by simp
+  moreover have "(c^4) * (card A)/16 >0" 
+    using assms card_0_eq by fastforce
+  moreover have "((2^13) * (1/c^15) * (card A))^2/(card B) = 
+    ((2^13)* (1/c^15) * (card A))^2 * (1/(card B))" by simp
+  moreover have "((2^13) * (1/c^15)*(card A))^2 * (1/(card B)) \<le> 
+    ((2^13) * (1/c^15) * (card A))^2/ ((c^4) * (card A)/16)" using bge frac_le less_eq_real_def 
+    zero_le_power2 calculation(2, 3) by metis
+  ultimately have "(card (sumset A' A')) \<le> ((2^13) * (1/c^15)*(card A))^2/ ((c^4) * (card A)/16)" 
+    by linarith
+  then have "(card (sumset A' A')) \<le> (2^30) * (card A)/(c^34)"
+    using card_0_eq assms by (simp add: power2_eq_square)
+  then show ?thesis using a2ss a2ne a2ge that by blast
+qed 
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Supplementary.thy b/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Supplementary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Balog_Szemeredi_Gowers_Supplementary.thy
@@ -0,0 +1,606 @@
+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
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Graph_Theory_Preliminaries.thy b/thys/Balog_Szemeredi_Gowers/Graph_Theory_Preliminaries.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Graph_Theory_Preliminaries.thy
@@ -0,0 +1,241 @@
+section\<open>Background material for the graph-theoretic aspects of the main proof\<close>
+text \<open>This section includes a number of lemmas on project specific definitions for graph theory, 
+building on the general undirected graph theory library \cite{Undirected_Graph_Theory-AFP} \<close>
+
+(*
+  Session: Balog_Szemeredi_Gowers
+  Title:   Graph_Theory_Preliminaries.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Graph_Theory_Preliminaries
+  imports 
+    Miscellaneous_Lemmas
+    Undirected_Graph_Theory.Bipartite_Graphs
+    Undirected_Graph_Theory.Connectivity
+    Random_Graph_Subgraph_Threshold.Ugraph_Misc
+begin
+
+subsection\<open>On graphs with loops\<close>
+
+context ulgraph
+
+begin
+
+definition degree_normalized:: "'a \<Rightarrow> 'a set \<Rightarrow> real" where 
+  "degree_normalized v S \<equiv> card (neighbors_ss v S) / (card S)"
+
+lemma degree_normalized_le_1: "degree_normalized x S \<le> 1"
+
+proof(cases "finite S")
+  assume hA: "finite S"
+  then have "card (neighbors_ss x S) \<le> card S" using neighbors_ss_def card_mono hA 
+    by fastforce
+  then show ?thesis using degree_normalized_def divide_le_eq_1
+    by (metis antisym_conv3 of_nat_le_iff of_nat_less_0_iff)
+next
+  case False
+  then show ?thesis using degree_normalized_def by auto
+qed
+
+end
+
+subsection\<open>On bipartite graphs \<close>
+
+
+context bipartite_graph
+begin
+
+(* codegree counts the number of paths between two vertices, including loops *)
+definition codegree:: "'a \<Rightarrow> 'a \<Rightarrow> nat" where
+  "codegree v u \<equiv> card {x \<in> V . vert_adj v x \<and> vert_adj u x}"
+
+lemma codegree_neighbors: "codegree v u = card (neighborhood v \<inter> neighborhood u)"
+  unfolding codegree_def neighborhood_def 
+
+proof -
+  have "{x \<in> V. vert_adj v x \<and> vert_adj u x} = {va \<in> V. vert_adj v va} \<inter> {v \<in> V. vert_adj u v}"
+    by blast
+  thus "card {x \<in> V. vert_adj v x \<and> vert_adj u x} = card ({va \<in> V. vert_adj v va} \<inter> {v \<in> V. vert_adj u v})"
+    by auto
+qed
+
+lemma codegree_sym: "codegree v u = codegree u v"
+  by (simp add: Int_commute codegree_neighbors) 
+
+definition codegree_normalized:: "'a \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> real" where 
+  "codegree_normalized v u S \<equiv> codegree v u / card S"
+
+lemma codegree_normalized_altX: 
+  assumes "x \<in> X" and "x' \<in> X"
+  shows "codegree_normalized x x' Y = card (neighbors_ss x Y \<inter> neighbors_ss x' Y) / card Y"
+
+proof -
+  have "((neighbors_ss x Y) \<inter> (neighbors_ss x' Y)) = neighborhood x \<inter> neighborhood x'"
+    using neighbors_ss_eq_neighborhoodX assms by auto
+  then show ?thesis unfolding codegree_normalized_def
+    using codegree_def codegree_neighbors by presburger 
+qed
+
+lemma codegree_normalized_altY: 
+  assumes "y \<in> Y" and "y' \<in> Y"
+  shows "codegree_normalized y y' X = card (neighbors_ss y X \<inter> neighbors_ss y' X) / card X"
+
+proof -
+  have "neighbors_ss y X \<inter> neighbors_ss y' X = neighborhood y \<inter> neighborhood y'"
+    using neighbors_ss_eq_neighborhoodY assms by auto
+  then show ?thesis unfolding codegree_normalized_def
+    using codegree_def codegree_neighbors by presburger 
+qed
+
+lemma codegree_normalized_sym: "codegree_normalized u v S = codegree_normalized v u S"
+  unfolding codegree_normalized_def using codegree_sym by simp
+
+definition bad_pair:: " 'a \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow> bool" where 
+  "bad_pair v u S c \<equiv> codegree_normalized v u S < c"
+
+lemma bad_pair_sym: 
+  assumes "bad_pair v u S c" shows "bad_pair u v S c"
+  using assms bad_pair_def codegree_normalized_def
+  by (simp add: codegree_normalized_sym)
+
+definition bad_pair_set:: "'a set \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow> ('a \<times> 'a) set" where 
+  "bad_pair_set S T c  \<equiv> {(u, v) \<in> S \<times> S. bad_pair u v T c}"
+
+lemma bad_pair_set_ss: "bad_pair_set S T c \<subseteq> S \<times> S"
+  by (auto simp add: bad_pair_set_def)
+
+lemma bad_pair_set_filter_alt: 
+  "bad_pair_set S T c = Set.filter (\<lambda> p . bad_pair (fst p) (snd p) T c) (S \<times> S)" 
+  using bad_pair_set_def by auto
+
+lemma bad_pair_set_finite: 
+  assumes "finite S"
+  shows "finite (bad_pair_set S T c)"
+proof -
+  have "finite (S \<times> S)" using finite_cartesian_product assms by blast
+  thus ?thesis using bad_pair_set_filter_alt finite_filter by auto
+qed
+
+lemma codegree_is_path_length_two:
+  "codegree x x' = card {p . connecting_path x x' p \<and> walk_length p = 2}" 
+  unfolding codegree_def 
+proof-
+  define f:: "'a list \<Rightarrow> 'a" where "f = (\<lambda> p. p!1)"
+  have f_inj: "inj_on f {p . connecting_path x x' p \<and> walk_length p = 2}"
+    unfolding f_def 
+  proof (intro inj_onI, simp del: One_nat_def)
+    fix a b assume ha: "connecting_path x x' a \<and> walk_length a = 2" and 
+      hb: "connecting_path x x' b \<and> walk_length b = 2" and 1: "a!1 = b!1"
+    then have len: "length a = 3" "length b = 3" using walk_length_conv by auto
+    show "a = b" using list2_middle_singleton 1 len list_middle_eq ha hb connecting_path_def len by metis 
+  qed
+  have f_image: "f ` {p . connecting_path x x' p \<and> walk_length p = 2} = 
+    {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
+  proof(intro subset_antisym)
+    show "f ` {p. connecting_path x x' p \<and> walk_length p = 2}
+    \<subseteq> {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
+    proof (intro subsetI)
+      fix a assume "a \<in> f ` {p. connecting_path x x' p \<and> walk_length p = 2}"
+      then obtain p where ha: "p!1 = a" and hp: "connecting_path x x' p" and hpl: "length p = 3" 
+        using f_def walk_length_conv by auto
+      have "p ! 0 = x" using hd_conv_nth[of p] hpl hp connecting_path_def by fastforce 
+      then have va1: "vert_adj x a" using is_walk_index[of 0 p] hp connecting_path_def is_gen_path_def 
+          vert_adj_def ha hpl by auto
+      have "p ! 2 = x'" using last_conv_nth[of p] hpl hp connecting_path_def by fastforce
+      then have "vert_adj a x'" using is_walk_index[of 1 p] hp connecting_path_def is_gen_path_def 
+          vert_adj_def ha hpl by (metis One_nat_def le0 lessI numeral_3_eq_3 one_add_one)
+      then show "a \<in> {a \<in> V. vert_adj x a \<and> vert_adj x' a}" 
+        using va1 vert_adj_sym by (simp add: vert_adj_imp_inV)
+    qed
+    show "{xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}
+      \<subseteq> f ` {p. connecting_path x x' p \<and> walk_length p = 2}"
+    proof (intro subsetI)
+      fix a assume ha: "a \<in> {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
+      then have "a \<in> V" and "x \<in> V" and "x' \<in> V" and "vert_adj x a" and "vert_adj x' a"
+        using vert_adj_imp_inV by auto
+      then have "is_gen_path [x, a, x']" 
+        using is_walk_def vert_adj_def vert_adj_sym ha singleton_not_edge is_gen_path_def by auto (* Slow *)
+      then have "connecting_path x x' [x, a, x']"
+        unfolding connecting_path_def vert_adj_def hd_conv_nth last_conv_nth by simp
+      moreover have "walk_length [x, a, x'] = 2" using walk_length_conv by simp
+      ultimately show "a \<in> f ` {p. connecting_path x x' p \<and> walk_length p = 2}" using f_def by force
+    qed
+  qed
+  then show "card {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa} =
+    card {p. connecting_path x x' p \<and> walk_length p = 2}" 
+    using f_inj card_image by fastforce
+qed
+
+lemma codegree_bipartite_eq: 
+  "\<forall> x \<in> X. \<forall> x' \<in> X. codegree x x' = card {y \<in> Y. vert_adj x y \<and> vert_adj x' y}"
+  unfolding codegree_def using vert_adj_imp_inV X_vert_adj_Y
+  by (metis (no_types, lifting) Collect_cong)
+
+lemma (in fin_bipartite_graph) bipartite_deg_square_eq:
+  "\<forall> y \<in> Y. (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y) = (degree y)^2"
+proof
+  have hX: "finite X" by (simp add: partitions_finite(1))
+  fix y assume hy: "y \<in> Y"
+  have 1: "\<forall> x' \<in> X. \<forall> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y = 
+    indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y"
+    by (metis (mono_tags, lifting) Int_Collect indicator_simps(1) indicator_simps(2) mem_Collect_eq)
+  have 2: "\<forall> x' \<in> X. \<forall> x \<in> X. (indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y:: nat) =
+    indicator {z. vert_adj x' z} y * indicator {z. vert_adj x z} y" using indicator_inter_arith 
+    by auto
+  have "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (indicator {z. vert_adj x z \<and> vert_adj x' z} y:: nat)) = 
+    (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y)" 
+    using 1 sum.cong by (metis (no_types, lifting))
+  also have "... = (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator {z. vert_adj x' z} y *
+    indicator {z. vert_adj x z} y)" using 2 sum.cong by auto
+  also have "... = sum (\<lambda> x. indicator {z. vert_adj x z} y) X * sum (\<lambda> x. indicator {z. vert_adj x z} y) X" 
+    using sum_product[of "(\<lambda> x. (indicator {z. vert_adj x z} y:: nat))" "X" 
+      "(\<lambda> x. indicator {z. vert_adj x z} y)" "X"] by auto
+  finally have 3: "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (indicator {z. vert_adj x z \<and> vert_adj x' z} y:: nat)) = 
+    (sum (\<lambda> x. indicator {z. vert_adj x z} y) X) ^ 2" using power2_eq_square
+    by (metis (no_types, lifting))
+  have "\<forall> x \<in> X. indicator {z. vert_adj x z} y = indicator {x. vert_adj x y} x"
+    by (simp add: indicator_def)
+  from this have "(sum (\<lambda> x. indicator {z. vert_adj x z} y) X) = sum (\<lambda> x. indicator {x. vert_adj x y} x) X"
+    using sum.cong by fastforce
+  also have "... = card ({x \<in> X. vert_adj x y})" using sum_indicator_eq_card hX
+    by (metis Collect_conj_eq Collect_mem_eq)
+  finally show "(\<Sum>x'\<in>X. \<Sum>x\<in>X. indicator {z. vert_adj x z \<and> vert_adj x' z} y) = (degree y)^2" 
+    using 3 hy degree_neighbors_ssY neighbors_ss_def vert_adj_sym by presburger 
+qed
+
+lemma (in fin_bipartite_graph) codegree_degree:          
+  "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (codegree x x')) = (\<Sum> y \<in> Y. (degree y)^2)"
+
+proof-
+  have hX: "finite X" and hY: "finite Y"
+    by (simp_all add: partitions_finite)
+  have "\<forall> x' \<in> X. \<forall> x \<in> X. {z \<in> V. vert_adj x z \<and> vert_adj x' z} = Y \<inter> {z. vert_adj x z \<and> vert_adj x' z}"
+    using XY_union X_vert_adj_Y by fastforce
+  from this have "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (codegree x x')) = (\<Sum> x' \<in> X. \<Sum> x \<in> X. card (Y \<inter> {z. vert_adj x z \<and> vert_adj x' z}))"
+    using codegree_def sum.cong by auto 
+  also have "... = (\<Sum> x' \<in> X. \<Sum> x \<in> X. \<Sum> y \<in> Y. indicator {z. vert_adj x z \<and> vert_adj x' z} y)" 
+    using sum_indicator_eq_card hY by fastforce
+  also have "... =  (\<Sum> x' \<in> X. \<Sum> y \<in> Y. (\<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y))"
+    using sum.swap by (metis (no_types))
+  also have "... = (\<Sum> y \<in> Y. \<Sum> x' \<in> X. (\<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y))" 
+    using sum.swap by fastforce
+  also have "... = (\<Sum> y \<in> Y. (degree y)^2)" using bipartite_deg_square_eq sum.cong by force
+  finally show ?thesis by simp
+qed
+
+lemma (in fin_bipartite_graph) sum_degree_normalized_X_density:
+  "(\<Sum> x \<in> X. degree_normalized x Y) / card X = edge_density X Y"
+  by (smt (z3) card_all_edges_betw_neighbor card_edges_between_set degree_normalized_def
+    divide_divide_eq_left' density_simp of_nat_mult of_nat_sum partitions_finite(1) 
+    partitions_finite(2) sum.cong sum_left_div_distrib)
+
+lemma (in fin_bipartite_graph) sum_degree_normalized_Y_density:
+  "(\<Sum> y \<in> Y. degree_normalized y X) / card Y = edge_density X Y"
+  using bipartite_sym fin_bipartite_graph.sum_degree_normalized_X_density fin_bipartite_graph_def 
+    fin_graph_system_axioms edge_density_commute by fastforce
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Miscellaneous_Lemmas.thy b/thys/Balog_Szemeredi_Gowers/Miscellaneous_Lemmas.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Miscellaneous_Lemmas.thy
@@ -0,0 +1,114 @@
+section\<open>Miscellaneous technical lemmas\<close>
+
+(*
+  Title:   Miscellaneous_Lemmas.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Miscellaneous_Lemmas
+  imports 
+    "HOL-Library.Indicator_Function"
+    "HOL-Analysis.Convex"
+begin
+
+lemma set_pairs_filter_subset: "A \<subseteq> B \<Longrightarrow> {p . p \<in> A \<times> A \<and> P p} \<subseteq> {p. p \<in> B \<times> B \<and> P p}"
+  by (intro subsetI) blast
+
+lemma card_set_ss_indicator: 
+  assumes "A \<subseteq> B"
+  assumes "finite B"
+  shows "card A = (\<Sum> p \<in> B. indicator A p)"
+proof -
+  obtain C where ceq: "C = B - A" by blast
+  then have beq: "B = A \<union> C" using assms by blast
+  have bint: "A \<inter> C = {}" using ceq by blast
+  have finite: "finite A" using assms finite_subset by auto 
+  have zero: "\<And> p. p \<in> C \<Longrightarrow> indicator (A) p = 0"
+    by (simp add: ceq) 
+  then have "card A = (\<Sum> p \<in> A . indicator (A) p)"
+    by simp 
+  also have "... = (\<Sum> p \<in> A . indicator A p) + (\<Sum> p \<in> C . indicator A p)" 
+    using zero by (metis add_cancel_left_right sum.neutral) 
+  finally show "card A = (\<Sum> p \<in> B. indicator A p)" using beq bint assms
+    by (metis add.commute ceq sum.subset_diff) 
+qed
+
+lemma card_cartesian_prod_square: "finite X \<Longrightarrow> card (X \<times> X) = (card X)^2" 
+  using card_cartesian_product by (simp add: power2_eq_square) 
+
+lemma (in ordered_ab_group_add) diff_strict1_mono: 
+  assumes "a > a'" "b \<le> b'"
+  shows "a - b > a' - b'"
+  using diff_strict_mono assms
+  by (metis local.diff_strict_right_mono local.dual_order.not_eq_order_implies_strict) 
+
+lemma card_cartesian_product_6: "card (A \<times> A \<times> A \<times> A \<times> A \<times> A) = (card A) ^ 6"
+proof-
+  have "card (A \<times> A \<times> A \<times> A \<times> A \<times> A) = 
+    card A * card A * card A * card A * card A * card A" 
+    using card_cartesian_product mult.commute by metis
+  then show ?thesis by algebra
+qed
+
+lemma card_cartesian_product3: "card (X \<times> Y \<times> Z) = card X * card Y * card Z"
+  using card_cartesian_product  by (metis mult.commute mult.left_commute)  
+
+
+lemma card_le_image_div:
+  fixes A:: "'a set" and B:: "'b set" and f:: "'a \<Rightarrow> 'b set" and r:: real
+  assumes "finite B" and "pairwise (\<lambda> s t. disjnt (f s) (f t)) A" and "\<forall> d \<in> A. (card (f d)) \<ge> r" 
+  and "\<forall> d \<in> A. f d \<subseteq> B" and "r > 0"
+  shows "card A \<le> card B / r"
+
+proof (cases "finite A")
+  assume hA: "finite A"
+  have hpair_disj: "pairwise disjnt (f ` A)" using assms by (metis pairwiseD pairwise_imageI)
+  have "r * card A = (\<Sum> d \<in> A. r)" by simp
+  also have "... \<le> (\<Sum> d \<in> A. card (f d))" using assms sum_mono by fastforce
+  also have "... = sum card (f ` A)" using assms hA by (simp add: sum_card_image)
+  also have "... = card (\<Union> d \<in> A. f d)" using assms hA hpair_disj
+    by (metis Sup_upper card_Union_disjoint finite_UN_I rev_finite_subset)
+  also have "... \<le> card B" using assms card_mono
+    by (metis UN_subset_iff of_nat_le_iff)
+  finally have "r * card A \<le> card B" by linarith
+  thus ?thesis using divide_le_eq assms by (simp add: mult_imp_le_div_pos mult_of_nat_commute)
+next
+  assume "\<not> finite A"
+  thus ?thesis using assms by auto
+qed
+
+lemma list_middle_eq: 
+  "length xs = length ys \<Longrightarrow> hd xs = hd ys \<Longrightarrow> last xs = last ys 
+    \<Longrightarrow> butlast (tl xs) = butlast (tl ys) \<Longrightarrow> xs = ys"
+  apply (induct xs ys rule: list_induct2, simp)
+  by (metis append_butlast_last_id butlast.simps(1) butlast.simps(2) butlast_tl hd_Cons_tl 
+      impossible_Cons le_refl list.sel(3) neq_Nil_conv)
+
+lemma list2_middle_singleton: 
+  assumes "length xs = 3"
+  shows "butlast (tl xs) = [xs ! 1]"
+proof (simp add: list_eq_iff_nth_eq assms)
+  have l: "length (butlast (tl xs)) = 1" using length_butlast length_tl assms by simp 
+  then have " butlast (tl xs) ! 0 = (tl xs) ! 0" using nth_butlast[of 0 "tl xs"] by simp
+  then show "butlast (tl xs) ! 0 = xs ! Suc 0" using nth_tl[of 0 xs]  l by simp
+qed
+
+
+lemma le_powr_half_mult:
+  fixes x y z:: real
+  assumes "x ^ 2 \<le> y * z" and "0 \<le> y" and "0 \<le> z"
+  shows "x \<le> y powr(1/2) * z powr (1/2)"
+  using assms power2_eq_square
+  by (metis dual_order.trans linorder_linear powr_ge_pzero powr_half_sqrt powr_mult real_le_rsqrt 
+    real_sqrt_le_0_iff)
+
+lemma Cauchy_Schwarz_ineq_sum2:
+  fixes f g:: "'a \<Rightarrow> real" and A:: "'a set"
+  shows "(\<Sum> d \<in> A. f d * g d) \<le> 
+    (\<Sum> d \<in> A. (f d)^2) powr (1/2) * (\<Sum> d \<in> A. (g d)^2) powr (1/2)"
+  using Convex.Cauchy_Schwarz_ineq_sum[of "f" "g" "A"] le_powr_half_mult sum_nonneg zero_le_power2
+  by (metis (mono_tags, lifting))
+
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/Prob_Space_Lemmas.thy b/thys/Balog_Szemeredi_Gowers/Prob_Space_Lemmas.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Prob_Space_Lemmas.thy
@@ -0,0 +1,135 @@
+section\<open>Auxiliary probability space results\<close>
+
+(*
+  Session : Balog_Szemeredi_Gowers
+  Title:   Prob_Space_Lemmas.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Prob_Space_Lemmas
+  imports 
+    Random_Graph_Subgraph_Threshold.Prob_Lemmas
+begin
+
+context prob_space
+
+begin
+
+lemma expectation_uniform_count:
+  assumes "M = uniform_count_measure X" and "finite X"
+  shows "expectation f = (\<Sum> x \<in> X. f x) / card X"
+
+proof-
+  have "expectation f = (\<Sum> x \<in> X. (1 / (card X)) * f x)" 
+    using assms uniform_count_measure_def bot_nat_0.extremum of_nat_0 of_nat_le_iff real_scaleR_def
+    lebesgue_integral_point_measure_finite[of _ "(\<lambda> x. 1 / card X)" "f"]
+    scaleR_sum_right sum_distrib_left zero_le_divide_1_iff by metis
+  then show ?thesis using sum_left_div_distrib by fastforce
+qed
+
+text \<open>A lemma to obtain a value for x where the inequality is satisfied \<close>
+lemma expectation_obtains_ge: 
+  fixes f :: "'a \<Rightarrow> real"
+  assumes "M = uniform_count_measure X" and "finite X"
+  assumes "expectation f \<ge> c"
+  obtains x where "x \<in> X" and "f x \<ge> c"
+
+proof -
+  have ne: "X \<noteq> {}"
+    using assms(1) subprob_not_empty by auto 
+  then have ne0: "card X > 0"
+    by (simp add: assms(2) card_gt_0_iff) 
+  have "\<exists> x \<in> X . f x \<ge> c"
+  proof (rule ccontr)
+    assume "\<not> (\<exists>x\<in>X. c \<le> f x)"
+    then have "\<forall>x\<in>X. c > f x" by auto 
+    then have "(\<Sum> x \<in> X. f x) < (\<Sum> x \<in> X. c)"
+      by (meson assms(2) ne sum_strict_mono) 
+    then have lt: "(\<Sum> x \<in> X. f x) < (card X) * c" by simp 
+    have "expectation f = (\<Sum> x \<in> X. f x) / card X" using expectation_uniform_count assms by auto
+    then have "(\<Sum> x \<in> X. f x) \<ge> (card X) * c" using ne0 assms
+      by (simp add: le_divide_eq mult_of_nat_commute)
+    then show False using lt by auto
+  qed
+  then show ?thesis using that by auto
+qed
+
+text \<open>The following is the variation on the Cauchy-Schwarz inequality presented in Gowers's notes 
+before Lemma 2.13 \cite{Gowersnotes}.\<close>
+
+lemma cauchy_schwarz_ineq_var:
+  fixes X :: "'a \<Rightarrow> real"
+  assumes "integrable M (\<lambda>x. (X x)^2)" and "X \<in> borel_measurable M"
+  shows "expectation (\<lambda> x. (X x)^2) \<ge> (expectation (\<lambda> x . (X x)))^2"
+
+proof -
+  have "expectation (\<lambda> x. (X x)^2) - (expectation (\<lambda> x . (X x)))^2 = expectation (\<lambda>x. (X x - expectation X)^2)"
+    using variance_expectation assms(1) assms(2) by presburger 
+  then have "expectation (\<lambda> x. (X x)^2) - (expectation (\<lambda> x . (X x)))^2 \<ge> 0" by simp
+  thus ?thesis by simp 
+qed
+
+lemma integrable_uniform_count_measure_finite: 
+  fixes g :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" 
+  shows "finite A \<Longrightarrow> integrable (uniform_count_measure A) g"
+  unfolding uniform_count_measure_def by (simp add: integrable_point_measure_finite)
+
+lemma cauchy_schwarz_ineq_var_uniform:
+  fixes X :: "'a \<Rightarrow> real"
+  assumes "M = uniform_count_measure S"
+  assumes "finite S"
+  shows "expectation (\<lambda> x. (X x)^2) \<ge> (expectation (\<lambda> x . (X x)))^2"
+
+proof -
+  have borel: "X \<in> borel_measurable M" using assms by (simp) 
+  have "integrable M X" using assms by (simp add: integrable_uniform_count_measure_finite)
+  then have "integrable M (\<lambda> x. (X x)^2)" using assms by (simp add: integrable_uniform_count_measure_finite)
+  thus ?thesis using cauchy_schwarz_ineq_var borel by simp 
+qed
+
+text \<open>An equation for expectation over a discrete random variables distribution: \<close>
+
+lemma expectation_finite_uniform_space: 
+  assumes "M = uniform_count_measure S" and "finite S"
+  fixes X :: "'a \<Rightarrow> real"
+  shows "expectation X = (\<Sum> y \<in> X ` S . prob {x \<in> S . X x = y} * y)"
+
+proof -
+  have "Bochner_Integration.simple_bochner_integrable M X"
+  proof (safe intro!: Bochner_Integration.simple_bochner_integrable.intros)
+    show "simple_function M X" unfolding simple_function_def using assms 
+      by (auto simp add: space_uniform_count_measure)
+    show "emeasure M {y \<in> space M. X y \<noteq> 0} = \<infinity> \<Longrightarrow> False"
+      using emeasure_subprob_space_less_top by (auto)
+  qed
+  then have "expectation X = Bochner_Integration.simple_bochner_integral M X" 
+    using simple_bochner_integrable_eq_integral by fastforce
+  thus ?thesis using Bochner_Integration.simple_bochner_integral_def space_uniform_count_measure
+    by (metis (no_types, lifting) Collect_cong assms(1) real_scaleR_def sum.cong) 
+qed
+
+lemma expectation_finite_uniform_indicator: 
+  assumes "M = uniform_count_measure S" and "finite S"
+  shows "expectation (\<lambda> x. indicator (T x) y) = prob {x \<in> S . indicator (T x) y = 1}" (is "expectation ?X = _")
+
+proof -
+  have ss: "?X ` S \<subseteq> {0, 1}"  
+    by (intro subsetI, auto simp add: indicator_eq_1_iff)
+  have diff: "\<And> y'. y' \<in> ({0, 1} - ?X ` S) \<Longrightarrow> prob {x \<in> S . ?X x = y'} = 0"
+    by (metis (mono_tags, lifting) DiffD2 empty_Collect_eq image_eqI measure_empty)
+  have "expectation ?X = (\<Sum> y \<in> ?X ` S . prob {x \<in> S . ?X x = y} * y)" 
+    using expectation_finite_uniform_space assms by auto
+  also have "... = (\<Sum> y \<in> ?X ` S . prob {x \<in> S . ?X x = y} * y) + 
+    (\<Sum> y \<in> ({0, 1} - ?X ` S) . prob {x \<in> S . ?X x = y} * y)"
+    using diff by auto
+  also have "... = (\<Sum> y \<in> {0, 1} . prob {x \<in> S . ?X x = y} * y)"
+    using sum.subset_diff[of "?X ` S" "{0, 1}" "\<lambda> y. prob {x \<in> S . ?X x = y} * y"] ss by fastforce 
+  also have "... = prob {x \<in> S . ?X x = 0} * 0 + prob {x \<in> S. ?X x = 1} * 1" by auto
+  finally have "expectation ?X = prob {x \<in> S. ?X x = 1}*1" by auto
+  thus ?thesis by (smt (verit) Collect_cong indicator_eq_1_iff) 
+qed
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/ROOT b/thys/Balog_Szemeredi_Gowers/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/ROOT
@@ -0,0 +1,20 @@
+chapter AFP
+
+session Balog_Szemeredi_Gowers (AFP) = "HOL-Probability" +
+  options [timeout = 800]
+  sessions
+    Pluennecke_Ruzsa_Inequality Random_Graph_Subgraph_Threshold
+    Undirected_Graph_Theory
+  theories
+    Miscellaneous_Lemmas
+    Graph_Theory_Preliminaries
+    Prob_Space_Lemmas 
+    Sumset_Triangle_Inequality
+    Additive_Combinatorics_Preliminaries
+    Additive_Energy_Lower_Bounds
+    Balog_Szemeredi_Gowers_Main_Proof
+    Balog_Szemeredi_Gowers_Supplementary
+  document_files
+    root.bib
+    root.tex
+
diff --git a/thys/Balog_Szemeredi_Gowers/Sumset_Triangle_Inequality.thy b/thys/Balog_Szemeredi_Gowers/Sumset_Triangle_Inequality.thy
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/Sumset_Triangle_Inequality.thy
@@ -0,0 +1,255 @@
+section\<open>A triangle inequality for sumsets\<close>
+
+(*
+  Session: Balog_Szemeredi_Gowers
+  Title:   Sumset_Triangle_Inequality.thy
+  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds 
+  Affiliation: University of Cambridge
+  Date: August 2022.
+*)
+
+theory Sumset_Triangle_Inequality
+  imports 
+    Pluennecke_Ruzsa_Inequality.Pluennecke_Ruzsa_Inequality
+begin
+
+context additive_abelian_group 
+
+begin
+
+text\<open>We show a useful triangle inequality for sumsets that does *not* follow from the Ruzsa triangle
+inequality. The proof follows the exposition in Zhao's book \cite{Zhaobook}. \<close>
+
+text\<open>The following auxiliary lemma corresponds to Lemma 7.3.4 in Zhao's book \cite{Zhaobook}.\<close>
+
+lemma triangle_ineq_sumsets_aux:
+  fixes X B Y :: "'a set"
+  assumes hX: "finite X" and hB: "finite B" and hXG: "X \<subseteq> G" and hBG: "B \<subseteq> G" and 
+    hXne: "X \<noteq> {}" and hYX: "\<And> Y. Y \<subseteq> X \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> card (sumset Y B) / card Y \<ge> 
+    card (sumset X B) / card X" and hC: "finite C" and hCne: "C \<noteq> {}" and hCG: "C \<subseteq> G"
+  shows "card (sumset X (sumset C B)) / card (sumset X C) \<le> card (sumset X B) / card X"
+  using hC hCne hCG proof (induct)
+  case empty
+  then show ?case by blast
+next
+  case hcase: (insert c C)
+  have hc : "c \<in> G" using hcase by auto
+  show "card (sumset X B) / card X \<ge>                    
+    card (sumset X (sumset (insert c C) B)) / card (sumset X (insert c C))"
+  proof(cases "C = {}")
+    case True
+    then have "card (sumset X (insert c C)) = card X" using hc hXG hX
+      by (simp add: card_sumset_singleton_eq le_iff_inf)
+    moreover have "card (sumset X (sumset (insert c C) B)) \<le> card (sumset X B)" using hX hB hBG hXG 
+      hc by (metis True card_sumset_le finite_sumset sumset_assoc sumset_commute)
+    ultimately show ?thesis by (simp add: divide_right_mono) 
+  next
+    case hCne: False
+    have hCG : "C \<subseteq> G" using hcase by auto
+    have hstep: "card (sumset X (sumset {c} B) - sumset X (sumset C B)) \<le> 
+      card (sumset X B) * card (sumset X {c} - sumset X C) / card X"
+    proof-
+      let ?Y = "{x \<in> X. sumset {x} (sumset {c} B) \<subseteq> sumset X (sumset C B)}"
+      have hYX : "?Y \<subseteq> X" and hY: "finite ?Y" using finite_subset hX by auto
+      have hsub1: "sumset X (sumset {c} B) - sumset X (sumset C B) \<subseteq> 
+        sumset (sumset X {c} - sumset X C) B"
+        by (metis Diff_subset_conv Un_Diff_cancel sumset_assoc sumset_subset_Un1 sup.cobounded2)
+      have hcard1 : "card (sumset X B) = card (sumset X (sumset {c} B))"
+        by (metis card_sumset_singleton_eq finite_sumset hB hX hc sumset_Int_carrier sumset_assoc 
+            sumset_commute)
+      have hcard2 : "card (sumset ?Y B) = card (sumset (sumset ?Y {c}) B)"
+        using card_sumset_singleton_eq finite_sumset hB hY hc sumset_Int_carrier sumset_assoc 
+        sumset_commute by (smt (verit, ccfv_threshold))
+      have "sumset (sumset ?Y {c}) B \<subseteq> sumset X (sumset C B)"
+      proof
+        fix d assume "d \<in> sumset (sumset ?Y {c}) B"     
+        then obtain a b where ha: "a \<in> ?Y" and "b \<in> B" and hd: "d = a \<oplus> c \<oplus> b"
+          by (smt (verit) empty_iff insert_iff sumset.cases)
+        then have "a \<oplus> c \<oplus> b \<in> sumset {a} (sumset {c} B)"
+          by (smt (verit) associative composition_closed hBG hXG hc insertCI mem_Collect_eq subsetD
+            sumset.sumsetI)
+        then show "d \<in> sumset X (sumset C B)" using ha hd by blast
+      qed
+      then have hdisj : "disjnt ((sumset X (sumset {c} B)) - (sumset X (sumset C B)))
+        (sumset (sumset ?Y {c}) B)"
+        by (auto simp add : disjnt_iff)
+      have hsub2 : "sumset (sumset X {c} - sumset X C) B \<union> sumset (sumset ?Y {c}) B \<subseteq> 
+        sumset (sumset X {c}) B" by (simp add: sumset_mono)
+      then have ineq1: "card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset ?Y B) \<le> 
+        card (sumset X B)"
+      proof-
+      have "card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset ?Y B) = 
+        card ((sumset X (sumset {c} B) - sumset X (sumset C B)) \<union> sumset (sumset ?Y {c}) B)" 
+          using hdisj hcard2 card_Un_disjnt finite_sumset hX hYX finite_subset hB
+          by (metis (no_types, lifting) finite.emptyI finite.insertI finite_Diff)
+      also have "... \<le> card (sumset X (sumset {c} B))" using card_mono finite_sumset hX hB
+        by (metis (no_types, lifting) Diff_subset Un_subset_iff finite.emptyI finite.insertI 
+            hsub2 sumset_assoc)
+      finally show "card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset ?Y B) \<le> 
+        card (sumset X B)" using hcard1 by auto
+    qed
+    have ineq2: "card (sumset X {c} - sumset X C)  \<ge> card X - card ?Y"
+    proof-
+      let ?Z = "{x \<in> X. sumset {x} {c} \<subseteq> sumset X C}"
+      have hZY: "?Z \<subseteq> ?Y"
+        by (smt (verit, del_insts) Collect_mono_iff subset_refl sumset_assoc sumset_mono)
+      have hinj: "inj_on (\<lambda> x. x \<oplus> c) (X - ?Z)" 
+      proof (intro inj_onI)
+        fix x y assume "x \<in> X - ?Z" and "y \<in> X - ?Z" and h: "x \<oplus> c = y \<oplus> c"
+        then have "x \<in> G" and "y \<in> G" using hXG by auto
+        then show "x = y" using h hc by simp
+      qed
+      have himage: "(\<lambda> x. x \<oplus> c) ` (X - ?Z) = sumset X {c} - sumset X C"
+      proof
+        show "(\<lambda>x. x \<oplus> c) ` (X - ?Z) \<subseteq> sumset X {c} - sumset X C"
+        proof(intro image_subsetI)
+          fix x assume hx: "x \<in> X - ?Z"
+          then have hxG : "x \<in> G" using hXG by auto
+          then have hxc1: "x \<oplus> c \<in> sumset X {c}" using hXG hc hx by auto
+          have "x \<oplus> c \<in> sumset {x} {c}" using hxG hc by auto
+          then have hxc2: "x \<oplus> c \<notin> sumset X C" using hx hXG hc hCG
+            using DiffD2 sumset.simps sumset.sumsetI by auto
+          then show "x \<oplus> c \<in> sumset X {c} - sumset X C" using hxc1 hxc2 by simp
+        qed
+        show "sumset X {c} - sumset X C \<subseteq> (\<lambda>x. x \<oplus> c) ` (X - ?Z)"
+        proof
+          fix d assume "d \<in> sumset X {c} - sumset X C"
+          then obtain x where hd: "d = x \<oplus> c" and hxc: "x \<oplus> c \<notin> sumset X C" and hx: "x \<in> X"
+            using sumset.cases by force
+          then show "d \<in> (\<lambda>x. x \<oplus> c) ` (X - ?Z)" using hd hxc hx hXG hc by auto          
+        qed
+      qed
+      have hcard3: "card (X - ?Z) = card (sumset X {c} - sumset X C)" 
+        using card_image hinj himage by fastforce
+      have "card X = card ?Z + card (X - ?Z)" 
+        by (simp add: card_Diff_subset card_mono hX)
+      also have "... \<le> card ?Y + card (sumset X {c} - sumset X C)" 
+        using hcard3 card_mono hZY hY by auto
+      finally show ?thesis by simp
+    qed
+    have ineq3: "card (sumset X B) - card (sumset ?Y B) \<le> 
+      card (sumset X B) * (card X - card ?Y) / card X"
+    proof(cases "?Y = {}")
+      case True
+      then show ?thesis using card_eq_0_iff 
+        by (smt (verit) hX hXne minus_nat.diff_0 nonzero_mult_div_cancel_right of_nat_eq_0_iff 
+        of_nat_mult sumset_empty(2))
+    next
+      case hYne: False
+      have "card (sumset ?Y B) \<ge> card (sumset X B) / card X * card ?Y" using assms(6)[OF hYX hYne] 
+        hX hYne hX hYX finite_subset divide_le_eq
+        by (smt (z3) card_gt_0_iff hY mult_imp_div_pos_less of_nat_0_less_iff)
+      moreover have "card (sumset X B) / card X * card ?Y = (card (sumset X B) * card ?Y) / card X"
+        by auto
+      moreover have "card (sumset X B) * card ?Y / card X  * card X = card (sumset X B) * card ?Y"
+        using hX by (simp add: field_simps)
+      ultimately have "card (sumset ?Y B) * card X \<ge> card (sumset X B) * card ?Y" 
+        using hX hXne of_nat_0_less_iff le_divide_eq 
+        by (smt (z3) card_sumset_0_iff hBG hXG mult_cancel1 mult_cancel2 of_nat_le_0_iff 
+        of_nat_le_iff of_nat_mult)
+      then have "real ((card (sumset X B) - card (sumset ?Y B)) * card X) \<le> 
+        card (sumset X B) * (card X - card ?Y)"
+        by (simp add: diff_mult_distrib diff_mult_distrib2)
+      thus ?thesis using le_divide_eq card_eq_0_iff hX hXne
+        by (smt (z3) of_nat_le_0_iff of_nat_mult)
+    qed
+    show ?thesis 
+    proof-
+      have "real (card ((sumset X (sumset {c} B)) - (sumset X (sumset C B)))) \<le> 
+        card (sumset X B) - card (sumset ?Y B)" using ineq1 by auto
+      also have "... \<le> card (sumset X B) * (card X - card ?Y) / card X" using ineq3 by auto
+      also have "... \<le> card (sumset X B) * card (sumset X {c} - sumset X C) / card X" using ineq2
+        divide_le_cancel of_nat_less_0_iff of_nat_mono by (smt (verit, del_insts) mult_le_mono2)
+      finally show ?thesis by simp
+    qed
+  qed
+  have hinsert: "real (card (sumset X (sumset (insert c C) B))) / real (card (sumset X (insert c C))) = 
+  (card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset X (sumset C B))) / 
+  (card (sumset X {c} - sumset X C) + card (sumset X C))"
+    using sumset_insert2 card_Un_disjoint finite_sumset hX hB hC Diff_disjoint Int_commute 
+    Un_commute finite.emptyI finite.insertI finite_Diff hcase.hyps(1)
+    by (smt (verit) Un_Diff_cancel2 insert_is_Un sumset_commute sumset_subset_Un2)
+  have hsplit: "real (card (sumset X B)) * (card (sumset X {c} - sumset X C) + card (sumset X C)) / card X = 
+  real (card (sumset X B)) * card (sumset X {c} - sumset X C) / card X + 
+  card (sumset X B) * card (sumset X C) / card X"
+    by (smt (verit, ccfv_threshold) add_divide_distrib add_mult_distrib2 of_nat_add of_nat_mult)
+  have hind: "card (sumset X B) * card (sumset X C) / card X \<ge> card (sumset X (sumset C B))"
+    using hcase(3)[OF hCne hCG] hXne hCne hcase(1) hX finite_sumset card_gt_0_iff
+    add_mult_distrib2 of_nat_mult card_eq_0_iff card_sumset_0_iff hCG 
+    hXG of_nat_0_less_iff by (metis (no_types, opaque_lifting) divide_le_eq times_divide_eq_left)
+  have "real (card (sumset X B)) * (card (sumset X {c} - sumset X C) + card (sumset X C)) / card X \<ge>
+  (card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset X (sumset C B)))" 
+    using hsplit hind hstep by simp
+  then have "card (sumset X B) / card X \<ge> 
+    (card (sumset X (sumset {c} B) - sumset X (sumset C B)) + card (sumset X (sumset C B))) / 
+    (card (sumset X {c} - sumset X C) + card (sumset X C))" using card_sumset_0_iff hCG hXG 
+    card_eq_0_iff hC hX hXne hCne divide_self le_divide_eq
+    by (smt (z3) add_is_0 hcase.hyps(1) of_nat_le_0_iff times_divide_eq_left)
+  thus "real (card (sumset X (sumset (insert c C) B))) / real (card (sumset X (insert c C))) \<le> 
+    real (card (sumset X B)) / real (card X)" using hinsert by auto
+  qed
+qed
+
+
+text\<open>The following inequality is the result corresponding to Corollary 7.3.6 in Zhao's book \cite{Zhaobook}.\<close>
+
+lemma triangle_ineq_sumsets: 
+  assumes hA: "finite A" and hB: "finite B" and hC: "finite C" and
+  hAG : "A \<subseteq> G" and hBG: "B \<subseteq> G" and hCG: "C \<subseteq> G"
+  shows "card A * card (sumset B C) \<le> card (sumset A B) * card (sumset A C)"
+
+proof(cases "A = {}")
+  case True
+  then show ?thesis by simp
+next
+  case hAne: False
+  show "card A * card (sumset B C) \<le> card (sumset A B) * card (sumset A C)"
+  proof(cases "B = {}")
+    case True
+    then show ?thesis by simp
+  next
+    case hBne: False
+    define KS where "KS \<equiv> (\<lambda>X. card (sumset X C) / real (card X)) ` (Pow A - {{}})"
+    define K where "K \<equiv> Min KS"
+    define X where "X \<equiv> @X. X \<in> Pow A - {{}} \<and> K = card (sumset X C) / real (card X)"
+    obtain KS: "finite KS" "KS \<noteq> {}"
+      using KS_def hA hAne by blast
+    then have "K \<in> KS"
+      using K_def Min_in by blast
+    then have "\<exists>X. X \<in> Pow A - {{}} \<and> K = card (sumset X C) / real (card X)"
+      using KS_def by blast
+    then obtain "X \<in> Pow A - {{}}" and Keq: "K = card (sumset X C) / real (card X)"
+      by (metis (mono_tags, lifting) X_def someI_ex)
+    then have hX: "X \<subseteq> A" "X \<noteq> {}"
+      by auto
+    have hXmin : "\<And> Y. Y \<subseteq> A \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> 
+      card (sumset X C) / card X \<le> card (sumset Y C) / card Y"
+      using K_def KS_def Keq Min_le KS(1) by auto
+    then have hXAineq: "card (sumset X C) / card X \<le> card (sumset A C) / card A"
+      by (metis hAne subset_refl)
+    have haux: "real (card (sumset X (sumset B C))) / real (card (sumset X B))
+      \<le> real (card (sumset X C)) / real (card X)" using triangle_ineq_sumsets_aux[of "X" "C" "B"] 
+      hXmin hX hA hAG finite_subset hB hC hBne hBG hC hCG subset_trans by metis
+    have hXAsumset : "real (card (sumset X B)) \<le> card (sumset A B)" 
+      using hX(1) card_mono hA finite_sumset hB order_refl sumset_mono
+      by (metis of_nat_le_iff)
+    have "card (sumset B C) \<le> card (sumset X (sumset B C))" using assms hX
+      finite_sumset hAG card_le_sumset
+      by (metis bot.extremum_uniqueI dual_order.trans infinite_super subsetD subsetI 
+        sumset_subset_carrier)
+    also have "... \<le> (card (sumset X C) / card X) * card (sumset X B)" using haux divide_le_eq
+      card_sumset_0_iff hBne hX hB hA finite_subset card_0_eq by (smt (verit) hCG mult_eq_0_iff 
+      of_nat_0_eq_iff of_nat_0_le_iff sumset_assoc sumset_subset_carrier)
+    also have "... \<le> (card (sumset A C) / card A) * card (sumset A B)" 
+      using hXAineq hXAsumset by (meson divide_nonneg_nonneg mult_mono' of_nat_0_le_iff)
+    finally have "card (sumset B C) \<le> (card (sumset A C) * card (sumset A B)) / card A" by simp
+    then have "card (sumset B C) * card A \<le> card (sumset A C) * card (sumset A B)" 
+      using le_divide_eq hAne hA card_gt_0_iff by (smt (verit, ccfv_threshold) 
+      card_0_eq of_nat_le_0_iff of_nat_le_iff of_nat_mult)
+    thus "card A * card (sumset B C) \<le> card (sumset A B) * card (sumset A C)"
+      by (simp add: mult.commute)
+  qed
+qed
+
+end
+end
\ No newline at end of file
diff --git a/thys/Balog_Szemeredi_Gowers/document/root.bib b/thys/Balog_Szemeredi_Gowers/document/root.bib
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/document/root.bib
@@ -0,0 +1,51 @@
+%% This BibTeX bibliography file was created using BibDesk.
+%% http://bibdesk.sourceforge.net/
+
+
+
+
+%% Saved with string encoding Unicode (UTF-8) 
+
+@article{GowersnewSzemeredi,
+  author        = {Gowers, W. T.},
+  date-modified = {2022-03-07 16:02:40 +0000},
+  doi           = {10.1007/s00039-001-0332-9},
+  isbn          = {1420-8970},
+  journal       = {Geometric \& Functional Analysis GAFA},
+  number        = {3},
+  pages         = {465-588},
+  title         = {A New Proof of {Szemer{\'e}di's} Theorem},
+  volume        = {11},
+  year          = {2001},
+  bdsk-url-1    = {https://doi.org/10.1007/s00039-001-0332-9}
+}
+
+@misc{Gowersnotes,
+  author = {Gowers, W. T.},
+  note   = {Lecture notes for Part III of the Mathematics Tripos taught at the University of Cambridge, available at \url{https://drive.google.com/file/d/1ut0mUqSyPMweoxoDTfhXverEONyFgcuO/view}},
+  title  = {Introduction to Additive Combinatorics},
+  year   = {2022}
+}
+
+
+@misc{Zhaobook,
+  author        = {Yufei Zhao},
+  date-added    = {2022-04-01 15:01:03 +0100},
+  date-modified = {2022-04-01 15:01:41 +0100},
+  howpublished  = {Online at \url{https://yufeizhao.com/gtacbook/}},
+  note          = {book draft},
+  title         = {Graph Theory and Additive Combinatorics},
+  year          = {2022}
+}
+
+@article{Undirected_Graph_Theory-AFP,
+  author  = {Chelsea Edmonds},
+  title   = {Undirected Graph Theory},
+  journal = {Archive of Formal Proofs},
+  month   = {September},
+  year    = {2022},
+  note    = {\url{https://isa-afp.org/entries/Undirected_Graph_Theory.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
diff --git a/thys/Balog_Szemeredi_Gowers/document/root.tex b/thys/Balog_Szemeredi_Gowers/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/Balog_Szemeredi_Gowers/document/root.tex
@@ -0,0 +1,62 @@
+\documentclass[11pt,a4paper]{article}
+\usepackage[T1]{fontenc}
+\usepackage{amssymb}
+\usepackage{isabelle,isabellesym}
+\usepackage[english]{babel}  % for guillemots
+
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+\begin{document}
+
+\title{The Balog--Szemer\'{e}di--Gowers Theorem}
+\author{Angeliki Koutsoukou-Argyraki, Mantas Bak\v{s}ys, and Chelsea Edmonds\\
+University of Cambridge\\
+\texttt{\{ak2110, mb2412, cle47\}@cam.ac.uk}}
+
+\maketitle
+
+\begin{abstract}
+We formalise the Balog--Szemer\'{e}di--Gowers Theorem,  a profound result in additive combinatorics  which played a central role in Gowers's  proof deriving the first effective bounds for Szemer\'{e}di's Theorem \cite{GowersnewSzemeredi}.
+The proof is of great mathematical interest given that it involves an interplay between different mathematical areas, namely applications of graph theory and probability theory to additive combinatorics involving algebraic objects.
+This interplay is what made the process of the formalisation, for which we had to develop formalisations of new background material in the aforementioned areas, more rich and technically challenging.  We demonstrate how locales, Isabelle's module system, can be employed to handle such interplays.
+To treat the graph-theoretic aspects of the
+proof, we make use of a new, more general undirected graph theory library developed recently by Chelsea Edmonds, which is both flexible and extensible \cite{Undirected_Graph_Theory-AFP}.
+For the formalisation we followed a proof presented in the 2022 lecture notes by Timothy 
+Gowers "Introduction to Additive Combinatorics"  for Part III of the Mathematics Tripos taught at the University of Cambridge \cite{Gowersnotes}.
+ In addition to the main theorem, which, following our source, is formulated for difference sets, we 
+also give an alternative version for sumsets which required a formalisation of an auxiliary triangle inequality
+following a proof by Yufei Zhao from his book "Graph Theory and Additive 
+Combinatorics" \cite{Zhaobook}.
+We moreover formalise a few 
+additional results  in additive combinatorics that are not used in the proof of the main theorem. 
+This is the first formalisation of the Balog--Szemer\'{e}di--Gowers Theorem in any proof assistant to our knowledge. 
+
+\end{abstract}
+\newpage
+\tableofcontents
+
+\subsection*{Acknowledgements}
+Angeliki Koutsoukou-Argyraki is funded by the ERC Advanced Grant ALEXANDRIA (Project GA
+742178) funded by the European Research Council and led by Lawrence C. Paulson 
+(University of Cambridge, Department of Computer Science and Technology). 
+Mantas Bak\v{s}ys received funding for his internship supervised by Koutsoukou-Argyraki by the 
+Cambridge Mathematics Placements (CMP) Programme and by the ALEXANDRIA Project. 
+Chelsea Edmonds is jointly funded by the Cambridge Trust 
+(Cambridge Australia Scholarship) and a Cambridge Department of Computer Science and Technology Premium Research
+Studentship. 
+\newpage
+
+% include generated text of all theories
+\input{session}
+
+
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+
+\end{document}
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,711 +1,712 @@
 ADS_Functor
 AI_Planning_Languages_Semantics
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Ackermanns_not_PR
 Actuarial_Mathematics
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
+Balog_Szemeredi_Gowers
 BDD
 BD_Security_Compositional
 BNF_CC
 BNF_Operations
 BTree
 Banach_Steinhaus
 Belief_Revision
 Bell_Numbers_Spivey
 BenOr_Kozen_Reif
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 BirdKMP
 Blue_Eyes
 Bondy
 Boolean_Expression_Checkers
 Boolos_Curious_Inference
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRYSTALS-Kyber
 CRDT
 CSP_RefTK
 CYK
 CZH_Elementary_Categories
 CZH_Foundations
 CZH_Universal_Constructions
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 Clique_and_Monotone_Circuits
 ClockSynchInst
 Closest_Pair_Points
 CoCon
 CoSMeDis
 CoSMed
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Combinable_Wands
 Combinatorial_Enumeration_Algorithms
 Combinatorics_Words
 Combinatorics_Words_Graph_Lemma
 Combinatorics_Words_Lyndon
 Commuting_Hermitian
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Bounded_Operators
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Conditional_Simplification
 Conditional_Transfer_Rule
 Consensus_Refined
 Constructive_Cryptography
 Constructive_Cryptography_CM
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Core_SC_DOM
 Correctness_Algebras
 Cotangent_PFD_Formula
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 Cubic_Quartic_Equations
 DFS_Framework
 DOM_Components
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Dedekind_Real
 Deep_Learning
 Delta_System_Lemma
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Design_Theory
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Digit_Expansions
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 Dominance_CHK
 DPRM_Theorem
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Equivalence_Relation_Enumeration
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Eval_FO
 Example-Submission
 Extended_Finite_State_Machine_Inference
 Extended_Finite_State_Machines
 FFT
 FLP
 FOL-Fitting
 FOL_Axiomatic
 FOL_Harrison
 FOL_Seq_Calc1
 FOL_Seq_Calc2
 FOL_Seq_Calc3
 FSM_Tests
 Factor_Algebraic_Polynomial
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite-Map-Extras
 Finite_Automata_HF
 Finite_Fields
 Finitely_Generated_Abelian_Groups
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Fishers_Inequality
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_Puiseux_Series
 Formal_SSA
 Formula_Derivatives
 Foundation_of_geometry
 Fourier
 FO_Theory_Rewriting
 Free-Boolean-Algebra
 Free-Groups
 Frequency_Moments
 Fresh_Identifiers
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 GaleStewart_Games
 Gale_Shapley
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goedel_HFSet_Semantic
 Goedel_HFSet_Semanticless
 Goedel_Incompleteness
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Grothendieck_Schemes
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Hahn_Jordan_Decomposition
 Hales_Jewett
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hermite_Lindemann
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 Hood_Melville_Queue
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 Hyperdual
 IEEE_Floating_Point
 IFC_Tracking
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IMP_Compiler
 IMP_Compiler_Reuse
 IP_Addresses
 Imperative_Insertion_Sort
 Implicational_Logic
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
 Independence_CH
 Inductive_Confidentiality
 Inductive_Inference
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interpolation_Polynomials_HOL_Algebra
 Interpreter_Optimizations
 Interval_Arithmetic_Word32
 Intro_Dest_Elim
 Involutions2Squares
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 Irrationals_From_THEBOOK
 IsaGeoCoq
 Isabelle_C
 Isabelle_Marries_Dirac
 Isabelle_Meta_Model
 IsaNet
 Jacobson_Basic_Algebra
 Jinja
 JinjaDCI
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Khovanskii_Theorem
 Kleene_Algebra
 Knights_Tour
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Laws_of_Large_Numbers
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 Lifting_the_Exponent
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Logging_Independent_Anonymity
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 LP_Duality
 Lucas_Theorem
 MDP-Algorithms
 MDP-Rewards
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Maximum_Segment_Sum
 Max-Card-Matching
 Median_Method
 Median_Of_Medians_Selection
 Menger
 Mereology
 Mersenne_Primes
 Metalogic_ProofChecker
 MiniML
 MiniSail
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
 Modular_Assembly_Kit_Security
 Modular_arithmetic_LLL_and_HNF_algorithms
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multiset_Ordering_NPC
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nano_JSON
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Number_Theoretic_Transform
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PAC_Checker
 Package_logic
 PAL
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
 Padic_Ints
 Padic_Field
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Physical_Quantities
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Pluennecke_Ruzsa_Inequality
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Prefix_Free_Code_Combinators
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Progress_Tracking
 Projective_Geometry
 Projective_Measurements
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 Public_Announcement_Logic
 QHLProver
 QR_Decomposition
 Quantales
 Quasi_Borel_Spaces
 Quaternions
 Query_Optimization
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Real_Power
 Real_Time_Deque
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Registers
 Regression_Test_Selection
 Regular-Sets
 Regular_Algebras
 Regular_Tree_Relations
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Forests
 Relational_Method
 Relational_Minimum_Spanning_Trees
 Relational_Paths
 Rep_Fin_Groups
 ResiduatedTransitionSystem
 Residuated_Lattices
 Resolution_FOL
 Rewrite_Properties_Reduction
 Rewriting_Z
 Ribbon_Proofs
 Risk_Free_Lending
 Robbins-Conjecture
 Robinson_Arithmetic
 Root_Balanced_Tree
 Roth_Arithmetic_Progressions
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SC_DOM_Components
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Safe_Range_RC
 Saturation_Framework
 Saturation_Framework_Extensions
 SCC_Bloemen_Sequential
 Schutz_Spacetime
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 Separation_Logic_Unbounded
 SequentInvertibility
 Shadow_DOM
 Shadow_SC_DOM
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Simplicial_complexes_and_boolean_functions
 SimplifiedOntologicalArgument
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sophomores_Dream
 Solidity
 Sort_Encodings
 Source_Coding_Theorem
 SpecCheck
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Stalnaker_Logic
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 Sunflowers
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Syntax_Independent_Logic
 Szemeredi_Regularity
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Three_Circles
 Timed_Automata
 Topological_Semantics
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Transitive_Models
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 Types_To_Sets_Extension
 UPF
 UPF_Firewall
 UTP
 Undirected_Graph_Theory
 Universal_Hash_Families
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 Van_Emde_Boas_Trees
 Van_der_Waerden
 VectorSpace
 VeriComp
 Verified-Prover
 Verified_SAT_Based_AI_Planning
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 Virtual_Substitution
 VolpanoSmith
 VYDRA_MDL
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Weighted_Arithmetic_Geometric_Mean
 Weighted_Path_Order
 Well_Quasi_Orders
 Wetzels_Problem
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 X86_Semantics
 XML
 Youngs_Inequality
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL