(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_prop_39
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun y :: "Nat => Nat => bool" where
  "y (Z) (Z) = True"
| "y (Z) (S z2) = False"
| "y (S x2) (Z) = False"
| "y (S x2) (S y22) = y x2 y22"

fun x :: "bool => bool => bool" where
  "x True y2 = True"
| "x False y2 = y2"

fun elem :: "Nat => Nat list => bool" where
  "elem z (nil2) = False"
| "elem z (cons2 z2 xs) = x (y z z2) (elem z xs)"

fun drop :: "Nat => 'a list => 'a list" where
  "drop (Z) y2 = y2"
| "drop (S z2) (nil2) = nil2"
| "drop (S z2) (cons2 x2 x3) = drop z2 x3"

theorem property0 :
  "((elem z (drop y2 z2)) ==> (elem z z2))"
  oops

end


theory ex07
  imports Main "HOL-Data_Structures.Sorting" "HOL-Library.Tree"
begin

definition closer where
  "closer b a c = Some(case c of None \<Rightarrow> a
                               | Some v \<Rightarrow> (if abs (b - a) \<le> abs (b - v) then a else v))"

fun round :: "int tree \<Rightarrow> int \<Rightarrow> int option" where
  "round \<langle>\<rangle> _ = None"
| "round (Node l a r) b =
    (if a = b then
       Some a
     else if b < a then
       closer b a (round l b)
     else
       closer b a (round r b)
     )"

lemma "round t b = Some c \<Longrightarrow> c \<in> set_tree t"
  apply (induction t)
   apply (auto split: if_splits option.splits simp: closer_def)
  done

lemma "bst t \<Longrightarrow> round t b = Some c \<Longrightarrow> a \<in> set_tree t \<Longrightarrow> abs(b - c) \<le> abs (b - a)"
  apply (induction t b arbitrary: c rule: round.induct)
   apply (fastforce split: if_splits option.splits simp: closer_def)+
  done

fun t_round :: "int tree \<Rightarrow> int \<Rightarrow> nat" where
  "t_round \<langle>\<rangle> _ = 1"
| "t_round (Node l a r) b =
    (if a = b then
       1
     else if b < a then
       1 + (t_round l b)
     else
       1 + (t_round r b)
     )"

value "t_round \<langle>\<rangle> (-1)"

lemma "t_round t b \<le> height t + 1"
  apply(induction t)
  apply auto
  done

type_synonym intervals = "(nat*nat) list"

fun inv' where
  "inv' _ [] = True"
| "inv' n (iv#ivs) = (case iv of (l, h) \<Rightarrow> n \<le> l \<and> l \<le> h \<and> inv' (Suc (Suc h)) ivs )"

definition inv where "inv \<equiv> inv' 0"

fun set_of where
  "set_of [] = {}"
| "set_of (iv#ivs) = (case iv of (l,h) \<Rightarrow> {l..h} \<union> set_of ivs)"

fun merge_ivs where
  "merge_ivs (l,h) [] = [(l, h)]"
| "merge_ivs (l,h) (iv'#ivs') =
         (case iv' of (l', h') \<Rightarrow>
            if l' = Suc h then (l, h') # ivs' else (l, h)#(iv'#ivs'))"

fun add where
  "add a [] = (a,a)#[]"
| "add a (iv#ivs) = (case iv of (l, h) \<Rightarrow>
    if l \<le> a \<and> a \<le> h then
     (l,h)#ivs
   else if Suc a = l then
     (a,h)#ivs
   else if Suc (Suc a) \<le> l then
     (a,a)#(l, h)#ivs
   else if a = Suc h then
     merge_ivs (l, Suc h) ivs
   else iv # (add a ivs)
)"

value "add (1::nat) [(0,0), (3,3)]"

value "merge_ivs (0::nat, 0::nat) [(2, 3)]"

value "(add 1 [(0, 0::nat), (2, 3)])"

declare [[names_short]]

lemma add_correct_aux:
  shows "\<lbrakk>inv' n ivs; n \<le> x\<rbrakk> \<Longrightarrow> inv' n (add x ivs)"
proof (induction ivs arbitrary: n)
  case Nil
  then show ?case
    by (auto simp: inv_def)
next
  case (Cons a ivs)
  then show ?case
    apply(cases ivs)
     apply auto
    done
qed

lemma add_correct:
  shows "inv ivs \<Longrightarrow> inv (add x ivs)"
  using add_correct_aux
  by (auto simp: inv_def)

lemma [simp]: "a \<le> b \<Longrightarrow> inv' (Suc b) ivs \<Longrightarrow> set_of (merge_ivs (a, b) ivs) = {a..b} \<union> set_of ivs"
  apply (cases ivs)
  apply (auto split: if_splits)
  done

lemma add_correct_2_aux:
  shows "inv' m ivs  \<Longrightarrow> set_of (add x ivs) = insert x (set_of ivs)"
  apply (induction m ivs rule: inv'.induct)
   apply (auto split: if_splits)
  done

lemma add_correct_2:
  shows "inv ivs \<Longrightarrow> set_of (add x ivs) = insert x (set_of ivs)"
  using add_correct_2_aux
  by (auto simp: inv_def)

end


section \<open>Deciding Regular Expression Equivalence\<close>

theory Equivalence_Checking
imports
  NDerivative
  "HOL-Library.While_Combinator"
begin

subsection \<open>Bisimulation between languages and regular expressions\<close>

coinductive bisimilar :: "'a lang \<Rightarrow> 'a lang \<Rightarrow> bool" where
"([] \<in> K \<longleftrightarrow> [] \<in> L)
 \<Longrightarrow> (\<And>x. bisimilar (Deriv x K) (Deriv x L))
 \<Longrightarrow> bisimilar K L"

lemma equal_if_bisimilar:
assumes "bisimilar K L" shows "K = L"
proof (rule set_eqI)
  fix w
  from \<open>bisimilar K L\<close> show "w \<in> K \<longleftrightarrow> w \<in> L"
  proof (induct w arbitrary: K L)
    case Nil thus ?case by (auto elim: bisimilar.cases)
  next
    case (Cons a w K L)
    from \<open>bisimilar K L\<close> have "bisimilar (Deriv a K) (Deriv a L)"
      by (auto elim: bisimilar.cases)
    then have "w \<in> Deriv a K \<longleftrightarrow> w \<in> Deriv a L" by (rule Cons(1))
    thus ?case by (auto simp: Deriv_def)
  qed
qed

lemma language_coinduct:
fixes R (infixl "\<sim>" 50)
assumes "K \<sim> L"
assumes "\<And>K L. K \<sim> L \<Longrightarrow> ([] \<in> K \<longleftrightarrow> [] \<in> L)"
assumes "\<And>K L x. K \<sim> L \<Longrightarrow> Deriv x K \<sim> Deriv x L"
shows "K = L"
apply (rule equal_if_bisimilar)
apply (rule bisimilar.coinduct[of R, OF \<open>K \<sim> L\<close>])
apply (auto simp: assms)
done

type_synonym 'a rexp_pair = "'a rexp * 'a rexp"
type_synonym 'a rexp_pairs = "'a rexp_pair list"

definition is_bisimulation ::  "'a::order list \<Rightarrow> 'a rexp_pair set \<Rightarrow> bool"
where
"is_bisimulation as R =
  (\<forall>(r,s)\<in> R. (atoms r \<union> atoms s \<subseteq> set as) \<and> (nullable r \<longleftrightarrow> nullable s) \<and>
    (\<forall>a\<in>set as. (nderiv a r, nderiv a s) \<in> R))"

lemma bisim_lang_eq:
assumes bisim: "is_bisimulation as ps"
assumes "(r, s) \<in> ps"
shows "lang r = lang s"
proof -
  define ps' where "ps' = insert (Zero, Zero) ps"
  from bisim have bisim': "is_bisimulation as ps'"
    by (auto simp: ps'_def is_bisimulation_def)
  let ?R = "\<lambda>K L. (\<exists>(r,s)\<in>ps'. K = lang r \<and> L = lang s)"
  show ?thesis
  proof (rule language_coinduct[where R="?R"])
    from \<open>(r, s) \<in> ps\<close>
    have "(r, s) \<in> ps'" by (auto simp: ps'_def)
    thus "?R (lang r) (lang s)" by auto
  next
    fix K L assume "?R K L"
    then obtain r s where rs: "(r, s) \<in> ps'"
      and KL: "K = lang r" "L = lang s" by auto
    with bisim' have "nullable r \<longleftrightarrow> nullable s"
      by (auto simp: is_bisimulation_def)
    thus "[] \<in> K \<longleftrightarrow> [] \<in> L" by (auto simp: nullable_iff KL)
    fix a
    show "?R (Deriv a K) (Deriv a L)"
    proof cases
      assume "a \<in> set as"
      with rs bisim'
      have "(nderiv a r, nderiv a s) \<in> ps'"
        by (auto simp: is_bisimulation_def)
      thus ?thesis by (force simp: KL lang_nderiv)
    next
      assume "a \<notin> set as"
      with bisim' rs
      have "a \<notin> atoms r" "a \<notin> atoms s" by (auto simp: is_bisimulation_def)
      then have "nderiv a r = Zero" "nderiv a s = Zero"
        by (auto intro: deriv_no_occurrence)
      then have "Deriv a K = lang Zero"
        "Deriv a L = lang Zero"
        unfolding KL lang_nderiv[symmetric] by auto
      thus ?thesis by (auto simp: ps'_def)
    qed
  qed
qed

subsection \<open>Closure computation\<close>

definition closure ::
  "'a::order list \<Rightarrow> 'a rexp_pair \<Rightarrow> ('a rexp_pairs * 'a rexp_pair set) option"
where
"closure as = rtrancl_while (%(r,s). nullable r = nullable s)
  (%(r,s). map (\<lambda>a. (nderiv a r, nderiv a s)) as)"

definition pre_bisim :: "'a::order list \<Rightarrow> 'a rexp \<Rightarrow> 'a rexp \<Rightarrow>
 'a rexp_pairs * 'a rexp_pair set \<Rightarrow> bool"
where
"pre_bisim as r s = (\<lambda>(ws,R).
 (r,s) \<in> R \<and> set ws \<subseteq> R \<and>
 (\<forall>(r,s)\<in> R. atoms r \<union> atoms s \<subseteq> set as) \<and>
 (\<forall>(r,s)\<in> R - set ws. (nullable r \<longleftrightarrow> nullable s) \<and>
   (\<forall>a\<in>set as. (nderiv a r, nderiv a s) \<in> R)))"

subsection \<open>Bisimulation-free proof of closure computation\<close>

text\<open>The equivalence check can be viewed as the product construction
of two automata. The state space is the reflexive transitive closure of
the pair of next-state functions, i.e. derivatives.\<close>

lemma rtrancl_nderiv_nderivs: defines "nderivs == foldl (%r a. nderiv a r)"
shows "{((r,s),(nderiv a r,nderiv a s))| r s a. a : A}^* =
       {((r,s),(nderivs r w,nderivs s w))| r s w. w : lists A}" (is "?L = ?R")
proof-
  note [simp] = nderivs_def
  { fix r s r' s'
    have "((r,s),(r',s')) : ?L \<Longrightarrow> ((r,s),(r',s')) : ?R"
    proof(induction rule: converse_rtrancl_induct2)
      case refl show ?case by (force intro!: foldl.simps(1)[symmetric])
    next
      case step thus ?case by(force intro!: foldl.simps(2)[symmetric])
    qed
  } moreover
  { fix r s r' s'
    { fix w have "\<forall>x\<in>set w. x \<in> A \<Longrightarrow> ((r, s), nderivs r w, nderivs s w) :?L"
      proof(induction w rule: rev_induct)
        case Nil show ?case by simp
      next
        case snoc thus ?case by (auto elim!: rtrancl_into_rtrancl)
      qed
    }
    hence "((r,s),(r',s')) : ?R \<Longrightarrow> ((r,s),(r',s')) : ?L" by auto
  } ultimately show ?thesis by (auto simp: in_lists_conv_set) blast
qed

lemma nullable_nderivs:
  "nullable (foldl (%r a. nderiv a r) r w) = (w : lang r)"
by (induct w arbitrary: r) (simp_all add: nullable_iff lang_nderiv Deriv_def)

theorem closure_sound_complete:
assumes result: "closure as (r,s) = Some(ws,R)"
and atoms: "set as = atoms r \<union> atoms s"
shows "ws = [] \<longleftrightarrow> lang r = lang s"
proof -
  have leq: "(lang r = lang s) =
  (\<forall>(r',s') \<in> {((r0,s0),(nderiv a r0,nderiv a s0))| r0 s0 a. a : set as}^* `` {(r,s)}.
    nullable r' = nullable s')"
    by(simp add: atoms rtrancl_nderiv_nderivs Ball_def lang_eq_ext imp_ex nullable_nderivs
         del:Un_iff)
  have "{(x,y). y \<in> set ((\<lambda>(p,q). map (\<lambda>a. (nderiv a p, nderiv a q)) as) x)} =
    {((r,s), nderiv a r, nderiv a s) |r s a. a \<in> set as}"
    by auto
  with atoms rtrancl_while_Some[OF result[unfolded closure_def]]
  show ?thesis by (auto simp add: leq Ball_def split: if_splits)
qed

subsection \<open>The overall procedure\<close>

primrec add_atoms :: "'a rexp \<Rightarrow> 'a list \<Rightarrow> 'a list"
where
  "add_atoms Zero = id"
| "add_atoms One = id"
| "add_atoms (Atom a) = List.insert a"
| "add_atoms (Plus r s) = add_atoms s o add_atoms r"
| "add_atoms (Times r s) = add_atoms s o add_atoms r"
| "add_atoms (Star r) = add_atoms r"

lemma set_add_atoms: "set (add_atoms r as) = atoms r \<union> set as"
by (induct r arbitrary: as) auto

definition check_eqv :: "nat rexp \<Rightarrow> nat rexp \<Rightarrow> bool" where
"check_eqv r s =
  (let nr = norm r; ns = norm s; as = add_atoms nr (add_atoms ns [])
   in case closure as (nr, ns) of
     Some([],_) \<Rightarrow> True | _ \<Rightarrow> False)"

text\<open>Test:\<close>
lemma "check_eqv (Plus One (Times (Atom 0) (Star(Atom 0)))) (Star(Atom 0))"
by eval

end


section\<open>The Pl\"{u}nnecke-Ruzsa Inequality\<close>

text\<open>Authors: Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson, University of Cambridge.\<close>

text\<open>We formalise Pl\"{u}nnecke's inequality and the Pl\"{u}nnecke-Ruzsa inequality,
following the notes by Timothy Gowers: "Introduction to Additive
Combinatorics" (2022) for the University of Cambridge. To this end, we first introduce basic definitions
and prove elementary facts on sumsets and difference sets. Then, we show (two versions of)
the Ruzsa triangle inequality. We follow with a proof due to Petridis. \<close>

theory Pluennecke_Ruzsa_Inequality
  imports
    "Jacobson_Basic_Algebra.Ring_Theory"
    Complex_Main

begin

notation plus (infixl "+" 65)
notation minus (infixl "-" 65)
notation uminus ("- _" [81] 80)

subsection \<open>Key definitions (sumset, difference set) and basic lemmas \<close>

text \<open>Working in an arbitrary Abelian group, with additive syntax\<close>

locale additive_abelian_group = abelian_group G "(\<oplus>)" \<zero>
  for G and addition (infixl "\<oplus>" 65)  and zero ("\<zero>")

begin

abbreviation G_minus:: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<ominus>" 70)
  where "x \<ominus> y \<equiv> x \<oplus> inverse y "

lemma inverse_closed: "x \<in> G \<Longrightarrow> inverse x \<in> G"
  by blast

subsubsection \<open>Sumsets\<close>

inductive_set sumset :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" for A B
  where
    sumsetI[intro]: "\<lbrakk>a \<in> A; a \<in> G; b \<in> B; b \<in> G\<rbrakk> \<Longrightarrow> a \<oplus> b \<in> sumset A B"

lemma sumset_eq: "sumset A B = {c. \<exists>a \<in> A \<inter> G. \<exists>b \<in> B \<inter> G. c = a \<oplus> b}"
  by (auto simp: sumset.simps elim!: sumset.cases)

lemma sumset: "sumset A B = (\<Union>a \<in> A \<inter> G. \<Union>b \<in> B \<inter> G. {a \<oplus> b})"
  by (auto simp: sumset_eq)

lemma sumset_subset_carrier: "sumset A B \<subseteq> G"
  by (auto simp: sumset_eq)

lemma sumset_Int_carrier [simp]: "sumset A B \<inter> G = sumset A B"
  by (simp add: Int_absorb2 sumset_subset_carrier)

lemma sumset_mono: "\<lbrakk>A' \<subseteq> A; B' \<subseteq> B\<rbrakk> \<Longrightarrow> sumset A' B' \<subseteq> sumset A B"
  by (auto simp: sumset_eq)

lemma sumset_insert1: "NO_MATCH {} A \<Longrightarrow> sumset (insert x A) B = sumset {x} B \<union> sumset A B"
  by (auto simp: sumset_eq)

lemma sumset_insert2: "NO_MATCH {} B \<Longrightarrow> sumset A (insert x B) = sumset A {x} \<union> sumset A B"
  by (auto simp: sumset_eq)

lemma sumset_subset_Un1: "sumset (A \<union> A') B = sumset A B \<union> sumset A' B"
  by (auto simp: sumset_eq)

lemma sumset_subset_Un2: "sumset A (B \<union> B') = sumset A B \<union> sumset A B'"
  by (auto simp: sumset_eq)

lemma sumset_subset_insert: "sumset A B \<subseteq> sumset A (insert x B)" "sumset A B \<subseteq> sumset (insert x A) B"
  by (auto simp: sumset_eq)

lemma sumset_subset_Un: "sumset A B \<subseteq> sumset A (B\<union>C)" "sumset A B \<subseteq> sumset (A\<union>C) B"
  by (auto simp: sumset_eq)

lemma sumset_empty [simp]: "sumset A {} = {}" "sumset {} A = {}"
  by (auto simp: sumset_eq)

lemma sumset_empty':
  assumes "A \<inter> G = {}"
  shows "sumset B A = {}" "sumset A B = {}"
  using assms by (auto simp: sumset_eq)

lemma sumset_is_empty_iff [simp]: "sumset A B = {} \<longleftrightarrow> A \<inter> G = {} \<or> B \<inter> G = {}"
  by (auto simp: sumset_eq)

lemma sumset_D [simp]: "sumset A {\<zero>} = A \<inter> G" "sumset {\<zero>} A = A \<inter> G"
  by (auto simp: sumset_eq)

lemma sumset_Int_carrier_eq [simp]: "sumset A (B \<inter> G) = sumset A B" "sumset (A \<inter> G) B = sumset A B"
  by (auto simp: sumset_eq)

lemma sumset_assoc:
  shows "sumset (sumset A B) C = sumset A (sumset B C)"
  by (fastforce simp add: sumset_eq associative Bex_def)

lemma sumset_commute:
  shows "sumset A B = sumset B A"
  by (auto simp: sumset_eq; meson Int_iff commutative)

lemma finite_sumset:
  assumes "finite A" "finite B"  shows "finite (sumset A B)"
  using assms by (auto simp: sumset_eq)

lemma finite_sumset':
  assumes "finite (A \<inter> G)" "finite (B \<inter> G)"
    shows "finite (sumset A B)"
  using assms by (auto simp: sumset_eq)

lemma sumsetdiff_sing: "sumset (A - B) {x} = sumset A {x} - sumset B {x}"
  by (auto simp: sumset_eq)

lemma card_sumset_singleton_eq:
  assumes "finite A" shows "card (sumset A {a}) = (if a \<in> G then card (A \<inter> G) else 0)"
proof (cases "a \<in> G")
  case True
  then have "sumset A {a} = (\<lambda>x. x \<oplus> a) ` (A \<inter> G)"
    by (auto simp: sumset_eq)
  moreover have "inj_on (\<lambda>x. x \<oplus> a) (A \<inter> G)"
    by (auto simp: inj_on_def True)
  ultimately show ?thesis
    by (metis True card_image)
qed (auto simp: sumset_eq)

lemma card_sumset_le:
  assumes "finite A" shows "card (sumset A {a}) \<le> card A"
  by (simp add: assms card_mono card_sumset_singleton_eq)

lemma infinite_sumset_aux:
  assumes "infinite (A \<inter> G)"
  shows "infinite (sumset A B) \<longleftrightarrow> B \<inter> G \<noteq> {}"
proof (cases "B \<inter> G = {}")
  case False
  then obtain b where b: "b \<in> B" "b \<in> G" by blast
  with assms commutative have "((\<oplus>)b) ` (A \<inter> G) \<subseteq> sumset A B"
    by (auto simp: sumset)
  moreover have "inj_on ((\<oplus>)b) (A \<inter> G)"
    by (meson IntD2 b inj_onI invertible invertible_left_cancel)
  ultimately show ?thesis
    by (metis False assms inj_on_finite)
qed (auto simp: sumset_eq)

lemma infinite_sumset_iff:
  shows  "infinite (sumset A B) \<longleftrightarrow> infinite (A \<inter> G) \<and> B \<inter> G \<noteq> {} \<or> A \<inter> G \<noteq> {} \<and> infinite (B \<inter> G)"
  by (metis (no_types, lifting) finite_sumset' infinite_sumset_aux sumset_commute)

lemma card_le_sumset:
  assumes A: "finite A" "a \<in> A" "a \<in> G"
    and   B: "finite B" "B \<subseteq> G"
  shows "card B \<le> card (sumset A B)"
proof -
  have "B \<subseteq> (\<oplus>) (inverse a) ` sumset A B"
    using A B
    apply (clarsimp simp: sumset image_iff)
    by (metis Int_absorb2 Int_iff invertible invertible_left_inverse2)
  with A B show ?thesis
    by (meson  finite_sumset surj_card_le)
qed

lemma card_sumset_0_iff': "card (sumset A B) = 0 \<longleftrightarrow> card (A \<inter> G) = 0 \<or> card (B \<inter> G) = 0"
proof (cases "infinite (A \<inter> G) \<or> infinite (B \<inter> G)")
  case True
  then show ?thesis
    by (metis card_eq_0_iff infinite_sumset_iff sumset_empty')
qed (auto simp: sumset_eq)

lemma card_sumset_0_iff:
  assumes "A \<subseteq> G" "B \<subseteq> G"
  shows "card (sumset A B) = 0 \<longleftrightarrow> card A = 0 \<or> card B = 0"
  by (metis assms le_iff_inf card_sumset_0_iff')

lemma card_sumset_leq:
  assumes "A \<subseteq> G"
  shows "card(sumset A A) \<le> Suc(card A) choose 2"
  using assms
proof (induction "card A" arbitrary: A)
  case 0
  then show ?case
    by (metis card_sumset_0_iff zero_le)
next
  case (Suc n A)
  then obtain a A' where a: "a \<in> A" "A' = A - {a}" "a \<in> G"
    by (metis Zero_neq_Suc card_eq_0_iff subset_empty subset_eq)
  then have n: "card A' = n"
    by (metis Suc(2) card_Diff_singleton diff_Suc_Suc minus_nat.diff_0 One_nat_def)
  have "finite A"
    by (metis Suc(2) Zero_neq_Suc card.infinite)
  have "card (sumset A A) \<le> card (sumset A' A') + card A"
  proof -
    have A: "A = A' \<union> {a}"
      using a by auto
    then have "sumset A A = (sumset A' A') \<union> (sumset A {a})"
      by (auto simp: sumset_eq commutative)
    with a \<open>finite A\<close> card_sumset_le show ?thesis
      by (simp add: order_trans[OF card_Un_le])
  qed
  also have "\<dots> \<le> (card A) choose 2 + card A"
    using Suc a by (metis add_le_mono1 insert_Diff_single insert_absorb insert_subset n)
  also have "\<dots> \<le> Suc (card A) choose 2"
    by (simp add: numeral_2_eq_2)
  finally show ?case .
qed

subsubsection \<open>Iterated sumsets\<close>

definition sumset_iterated :: "'a set \<Rightarrow> nat \<Rightarrow> 'a set"
  where "sumset_iterated A r \<equiv> Finite_Set.fold (sumset \<circ> (\<lambda>_. A)) {\<zero>} {..<r}"

lemma sumset_iterated_0 [simp]: "sumset_iterated A 0 = {\<zero>}"
  by (simp add: sumset_iterated_def)

lemma sumset_iterated_Suc [simp]: "sumset_iterated A (Suc k) = sumset A (sumset_iterated A k)"
  (is "?lhs = ?rhs")
proof -
  interpret comp_fun_commute_on "{..k}" "sumset \<circ> (\<lambda>_. A)"
    using sumset_assoc sumset_commute by (auto simp: comp_fun_commute_on_def)
  have "?lhs = (sumset \<circ> (\<lambda>_. A)) k (Finite_Set.fold (sumset \<circ> (\<lambda>_. A)) {\<zero>} {..<k})"
    unfolding sumset_iterated_def lessThan_Suc
    by (subst fold_insert, auto)
  also have "\<dots> = ?rhs"
    by (simp add: sumset_iterated_def)
  finally show ?thesis .
qed

lemma sumset_iterated_2:
  shows "sumset_iterated A 2 = sumset A A"
  by (simp add: eval_nat_numeral)

lemma sumset_iterated_r: "r > 0 \<Longrightarrow> sumset_iterated A r = sumset A (sumset_iterated A (r-1))"
  using gr0_conv_Suc by force

lemma sumset_iterated_subset_carrier: "sumset_iterated A k \<subseteq> G"
  by (cases k; simp add: sumset_subset_carrier)

lemma finite_sumset_iterated: "finite A \<Longrightarrow> finite (sumset_iterated A r)"
  by(induction r) (auto simp: finite_sumset)

lemma sumset_iterated_empty: "r>0 \<Longrightarrow> sumset_iterated {} r = {}"
  by (induction r) auto

subsubsection \<open>Difference sets\<close>

inductive_set minusset :: "'a set \<Rightarrow> 'a set" for A
  where
    minussetI[intro]: "\<lbrakk>a \<in> A; a \<in> G\<rbrakk> \<Longrightarrow> inverse a \<in> minusset A"

lemma minusset_eq: "minusset A = inverse ` (A \<inter> G)"
  by (auto simp: minusset.simps)

abbreviation "differenceset A B \<equiv> sumset A (minusset B)"

lemma minusset_is_empty_iff [simp]: "minusset A = {} \<longleftrightarrow> A \<inter> G = {}"
  by (auto simp: minusset_eq)

lemma minusset_triv [simp]: "minusset {\<zero>} = {\<zero>}"
  by (auto simp: minusset_eq)

lemma minusset_subset_carrier: "minusset A \<subseteq> G"
  by (auto simp: minusset_eq)

lemma minus_minusset [simp]: "minusset (minusset A) = A \<inter> G"
  apply (auto simp: minusset_eq)
  by (metis inverse_equality invertible invertibleE minusset.minussetI minusset_eq)

lemma card_minusset [simp]: "card (minusset A) = card (A \<inter> G)"
proof (rule bij_betw_same_card)
  show "bij_betw (inverse) (minusset A) (A \<inter> G)"
    unfolding minusset_eq by (force intro: bij_betwI)
qed

lemma card_minusset': "A \<subseteq> G \<Longrightarrow> card (minusset A) = card A"
  by (simp add: Int_absorb2)

lemma diff_minus_set:
  "differenceset (minusset A) B = minusset (sumset A B)" (is "?lhs = ?rhs")
proof (rule Set.set_eqI)
  fix u
  have "u \<in> ?lhs \<longleftrightarrow>
          (\<exists>x \<in> A \<inter> G. \<exists>y \<in> B \<inter> G. u = inverse x \<ominus> y)"
    by (auto simp: sumset minusset_eq)
  also have "\<dots> \<longleftrightarrow> (\<exists>x \<in> A \<inter> G. \<exists>y \<in> B \<inter> G. u = inverse (y \<oplus> x))"
    using inverse_composition_commute by auto
  also have "\<dots> \<longleftrightarrow> u \<in> ?rhs"
    by (auto simp: sumset minusset_eq commutative)
  finally show "u \<in> ?lhs \<longleftrightarrow> u \<in> ?rhs" .
qed

lemma differenceset_commute [simp]:
  shows "minusset (differenceset B A) = differenceset A B "
  by (metis diff_minus_set minus_minusset sumset_Int_carrier_eq(1) sumset_commute)

lemma card_differenceset_commute: "card (differenceset B A) = card (differenceset A B)"
    by (metis card_minusset' differenceset_commute sumset_subset_carrier)

lemma minusset_distrib_sum:
  shows "minusset (sumset A B) = sumset (minusset A) (minusset B)"
  by (simp add: diff_minus_set)

lemma minusset_iterated_minusset: "sumset_iterated (minusset A) k = minusset (sumset_iterated A k)"
  by (induction k) (auto simp: diff_minus_set)

lemma card_sumset_iterated_minusset:
  "card (sumset_iterated (minusset A) k) = card (sumset_iterated A k)"
  by (metis card_minusset' minusset_iterated_minusset sumset_iterated_subset_carrier)

lemma finite_minusset: "finite A \<Longrightarrow> finite (minusset A)"
  by (simp add: minusset_eq)

lemma finite_differenceset: "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (differenceset A B)"
  by (simp add: finite_minusset finite_sumset)

subsection\<open>The Ruzsa triangle inequality\<close>

lemma Ruzsa_triangle_ineq1:
  assumes U: "finite U" "U \<subseteq> G"
    and   V: "finite V" "V \<subseteq> G"
    and   W: "finite W" "W \<subseteq> G"
  shows "(card U) * card(differenceset V W) \<le> card (differenceset U V) * card (differenceset U W)"
proof -
  have fin:  "finite (differenceset U V)" "finite (differenceset U W)"
    using U V W finite_minusset finite_sumset by auto
  have "\<exists>v w. v \<in> V \<and> w \<in> W \<and> x = v \<ominus> w" if "x \<in> differenceset V W" for x
    using that by (auto simp: sumset_eq minusset_eq)
  then obtain v w where vinV: "v x \<in> V" and winW: "w x \<in> W" and vw_eq: "v x \<ominus> (w x) = x"
    if "x \<in> differenceset V W" for x    by metis
  have vinG: "v x \<in> G" and winG: "w x \<in> G" if "x \<in> differenceset V W" for x
    using V W that vinV winW by auto
  define \<phi> where "\<phi> \<equiv> \<lambda>(u,x). (u \<ominus> (v x), u \<ominus> (w x))"
  have "inj_on \<phi> (U \<times> differenceset V W)"
  proof (clarsimp simp add: \<phi>_def inj_on_def)
    fix u1 :: 'a and x1 :: 'a and u2 :: 'a and x2 :: 'a
    assume "u1 \<in> U" "u2 \<in> U"
      and x1: "x1 \<in> differenceset V W"
      and x2: "x2 \<in> differenceset V W"
      and v: "u1 \<ominus> v x1 = u2 \<ominus> v x2"
      and w: "u1 \<ominus> w x1 = u2 \<ominus> w x2"
    then obtain "u1 \<in> G" "u2 \<in> G" "x1 \<in> G" "x2 \<in> G"
      by (meson \<open>U \<subseteq> G\<close> subset_iff sumset_subset_carrier)
    show "u1 = u2 \<and> x1 = x2"
    proof
      have "v x1 \<ominus> w x1 = (u1 \<ominus> w x1) \<ominus> (u1 \<ominus> v x1)"
        by (smt (verit, del_insts) \<open>u1 \<in> G\<close> associative commutative composition_closed inverse_closed
            invertible invertible_right_inverse2 vinG winG x1)
      also have "\<dots> = (u2 \<ominus> w x2) \<ominus> (u2 \<ominus> v x2)"
        using v w by presburger
      also have "\<dots> = v x2 \<ominus> w x2"
        by (smt (verit, del_insts) \<open>u2 \<in> G\<close> associative commutative composition_closed inverse_equality
            invertible invertible_def invertible_right_inverse2 vinG winG x2)
      finally have "v x1 \<ominus> w x1 = v x2 \<ominus> w x2" .
      then show "x1=x2"
        by (simp add: x1 x2 vw_eq)
      then show "u1=u2"
        using \<open>u1 \<in> G\<close> \<open>u2 \<in> G\<close> w winG x1 by force
    qed
  qed
  moreover have "\<phi> \<in> (U \<times> differenceset V W) \<rightarrow> (differenceset U V) \<times> (differenceset U W)"
    using \<open>U \<subseteq> G\<close> \<open>V \<subseteq> G\<close> \<open>W \<subseteq> G\<close>
    by (fastforce simp: \<phi>_def intro: vinV winW)
  ultimately have "card (U \<times> differenceset V W) \<le> card (differenceset U V \<times> differenceset U W)"
    using card_inj fin by blast
  then show ?thesis
    by (simp flip: card_cartesian_product)
qed

definition Ruzsa_distance:: "'a set \<Rightarrow> 'a set \<Rightarrow> real"
    where "Ruzsa_distance A B \<equiv> card(differenceset A B)/(sqrt(card A) * sqrt(card B))"

lemma Ruzsa_triangle_ineq2:
  assumes U: "finite U" "U \<subseteq> G" "U \<noteq> {}"
    and   V: "finite V" "V \<subseteq> G"
    and   W: "finite W" "W \<subseteq> G"
  shows "Ruzsa_distance V W \<le> (Ruzsa_distance V U) * (Ruzsa_distance U W)"
proof -
  have  "card U * card (differenceset V W) \<le> card (differenceset U V) * card (differenceset U W)"
    using assms Ruzsa_triangle_ineq1 by metis
  \<comment>\<open>now divide both sides with the same quantity\<close>
  then have "card U * card (differenceset V W) / (card U * sqrt (card V) * sqrt (card W))
         \<le> card (differenceset U V) * card (differenceset U W) / (card U * sqrt (card V) * sqrt (card W))"
    using assms
    by (metis divide_right_mono mult_eq_0_iff mult_left_mono of_nat_0_le_iff of_nat_mono real_sqrt_ge_0_iff)
  then have *: "card(differenceset V W) / (sqrt(card V) * sqrt(card W)) \<le>
                card (differenceset U V) * card (differenceset U W)
                / (card U * sqrt(card V) * sqrt(card W))"
    using assms by simp
  have "card (differenceset U V) * card (differenceset U W)/(card U * sqrt(card V) * sqrt(card W))
                  = card(differenceset V U) / (sqrt(card U) * sqrt(card V))*
                    card(differenceset U W) / (sqrt(card U) * sqrt(card W))"
    using assms
    by (simp add: divide_simps) (metis card_minusset differenceset_commute minus_minusset)
  then have
     "card(differenceset V W) / (sqrt(card V) * sqrt(card W)) \<le>
       card(differenceset V U) / (sqrt(card U) * sqrt(card V)) *
       card(differenceset U W) / (sqrt(card U) * sqrt(card W))"
    using * assms by auto
  then show ?thesis unfolding Ruzsa_distance_def
    by (metis divide_divide_eq_left divide_divide_eq_left' times_divide_eq_right)
qed

subsection \<open>Petridis's proof of the Pl\"{u}nnecke-Ruzsa inequality \<close>

lemma Plu_2_2:
  assumes K0: "card (sumset A0 B) \<le> K0 * real (card A0)"
    and   A0: "finite A0" "A0 \<subseteq> G" "A0 \<noteq> {}"
    and   B: "finite B" "B \<subseteq> G" "B \<noteq> {}"
  obtains A K
    where "A \<subseteq> A0" "A \<noteq> {}" "0 < K" "K \<le> K0"
      and "\<And>C. C \<subseteq> G \<Longrightarrow> finite C \<Longrightarrow> card (sumset A (sumset B C)) \<le> K * real (card(sumset A C))"
proof
  define KS where "KS \<equiv> (\<lambda>A. card (sumset A B) / real (card A)) ` (Pow A0 - {{}})"
  define K where "K \<equiv> Min KS"
  define A where "A \<equiv> @A. A \<in> Pow A0 - {{}} \<and> K = card (sumset A B) / real (card A)"
  obtain KS: "finite KS" "KS \<noteq> {}"
    using KS_def A0 by blast
  then have "K \<in> KS"
    using K_def Min_in by blast
  then have "\<exists>A. A \<in> Pow A0 - {{}} \<and> K = card (sumset A B) / real (card A)"
    using KS_def by blast
  then obtain "A \<in> Pow A0 - {{}}" and Keq: "K = card (sumset A B) / real (card A)"
    by (metis (mono_tags, lifting) A_def someI_ex)
  then show A: "A \<subseteq> A0" "A \<noteq> {}"
    by auto
  with A0 finite_subset have "A \<subseteq> G" "finite A"
    by blast+
  have gt0: "0 < real (card (sumset A B)) / real (card A)" if "A \<noteq> {}" and "A \<subseteq> A0" for A
    using that assms
    by (smt (verit, best) order_trans card_0_eq card_sumset_0_iff divide_pos_pos of_nat_le_0_iff finite_subset)
  then show "K > 0"
    using A Keq by presburger
  have K_cardA: "K * (card A) = card (sumset A B)"
    unfolding Keq using Keq \<open>0 < K\<close> by force
  have K_le: "real (card (sumset A' B)) / card A' \<ge> K" if "A' \<subseteq> A" "A' \<noteq> {}" for A'
    using KS K_def KS_def \<open>A \<subseteq> A0\<close> that by force
  with A0 have "card (sumset A0 B) / real (card A0) \<in> KS"
    by (auto simp: KS_def)
  with A0 show "K \<le> K0"
    by (metis KS K_def Min_le_iff card_gt_0_iff mult_imp_div_pos_le of_nat_0_less_iff K0)
  show "card (sumset A (sumset B C)) \<le> K * real (card(sumset A C))"
    if "finite C" "C \<subseteq> G" for C
    using that
  proof (induction C)
    case empty
    then show ?case by simp
      \<comment> \<open>This is actually trivial: it does not follow from @{term "card (sumset A B) = K * card A"}
         as claimed in the notes.\<close>
  next
    case (insert x C)
    then have "x \<in> G" "C \<subseteq> G" "finite C"
      by auto
    define A' where "A' \<equiv> A \<inter> {a. (a\<oplus>x) \<in> sumset A C}"
    with \<open>finite A\<close> have "finite A'" "A' \<subseteq> A" by auto
    then have [simp]: "real (card A - card A') = real (card A) - real (card A')"
      by (meson \<open>finite A\<close> card_mono of_nat_diff)
    have 0: "sumset A C \<inter> sumset (A - A') {x} = {}"
      by (clarsimp simp add: A'_def sumset_eq disjoint_iff) (metis IntI)
    have 1: "sumset A (insert x C) = sumset A C \<union> sumset (A - A') {x}"
      by (auto simp: A'_def sumset_eq)
    have "card (sumset A (insert x C)) = card (sumset A C) + card (sumset (A - A') {x})"
      by (simp add: 0 1 \<open>finite A\<close> card_Un_disjoint finite_sumset local.insert)
    also have "\<dots> = card (sumset A C) + card ((A - A') \<inter> G)"
      using \<open>finite A\<close> \<open>x \<in> G\<close> by (simp add: card_sumset_singleton_eq)
    also have "\<dots> = card (sumset A C) + card (A - A')"
      by (metis  \<open>A \<subseteq> G\<close> Int_absorb2 Int_Diff Int_commute)
    also have "\<dots> = card (sumset A C) + (card A - card A')"
      by (simp add: A'_def \<open>finite A\<close> card_Diff_subset)
    finally have *: "card (sumset A (insert x C)) = card (sumset A C) + (card A - card A')" .
    have "sumset A' (sumset B {x}) \<subseteq> sumset A (sumset B C)"
      by (clarsimp simp add: A'_def sumset_eq Bex_def) (metis associative commutative composition_closed)
    then have "sumset A (sumset B (insert x C))
                 \<subseteq> sumset A (sumset B C) \<union> (sumset A (sumset B {x}) - sumset A' (sumset B {x}))"
      by (auto simp: sumset_insert2 sumset_subset_Un2)
    then have "card (sumset A (sumset B (insert x C))) \<le> card (sumset A (sumset B C))
                           + card ((sumset A (sumset B {x}) - sumset A' (sumset B {x})))"
      by (smt (verit, best) B(1) \<open>finite A\<close> \<open>finite C\<close> order_trans card_Un_le card_mono finite.emptyI
              finite.insertI finite_Diff finite_Un finite_sumset)
    also have "\<dots> = card (sumset A (sumset B C)) + (card (sumset A (sumset B {x})) - card (sumset A' (sumset B {x})))"
      by (simp add: \<open>A' \<subseteq> A\<close> \<open>finite A'\<close> \<open>finite B\<close> card_Diff_subset finite_sumset sumset_mono)
    also have "\<dots> \<le> card (sumset A (sumset B C)) + (card (sumset A B) - card (sumset A' B))"
      using \<open>finite A\<close> \<open>finite A'\<close> \<open>finite B\<close> by (simp add: card_sumset_singleton_eq finite_sumset flip: sumset_assoc)
    also have "\<dots> \<le> K * card (sumset A C) + (K * card A - K * card A')"
    proof (cases "A' =  {}")
      case True
      with local.insert \<open>C \<subseteq> G\<close> K_cardA show ?thesis by auto
    next
      case False
      then have "K * card A' \<le> real (card (sumset A' B))"
        using K_le[OF \<open>A' \<subseteq> A\<close>] by (simp add: divide_simps split: if_split_asm)
      then have "real (card (sumset A B) - card (sumset A' B)) \<le> K * real (card A) - K * real (card A')"
        by (simp add: B(1) K_cardA \<open>A' \<subseteq> A\<close> \<open>finite A\<close> card_mono finite_sumset of_nat_diff sumset_mono)
      with local.insert show ?thesis by simp
    qed
    also have "\<dots> \<le> K * real (card (sumset A (insert x C)))"
      using * \<open>A' \<subseteq> A\<close> by (simp add: algebra_simps)
    finally show ?case
      using of_nat_mono by blast
  qed
qed

lemma Cor_Plu_2_3:
  assumes K: "card (sumset A B) \<le> K * real (card A)"
    and   A: "finite A" "A \<subseteq> G" "A \<noteq> {}"
    and   B: "finite B" "B \<subseteq> G"
  obtains A' where "A' \<subseteq> A" "A' \<noteq> {}"
                   "\<And>r. card (sumset A' (sumset_iterated B r)) \<le> K^r * real (card A')"
proof (cases "B = {}")
  case True
  have "K \<ge> 0"
    using assms by (simp add: True zero_le_mult_iff)
  moreover have *: "sumset_iterated B r = (if r=0 then {\<zero>} else {})" for r
    by (metis True sumset_iterated_0 sumset_iterated_empty zero_less_iff_neq_zero)
  ultimately have "real (card (sumset A (sumset_iterated B r)))
          \<le> K ^ r * real (card A)" for r
    by (simp add: "*" Int_commute  Int_absorb2 \<open>A \<subseteq> G\<close>)
  with \<open>A \<noteq> {}\<close> that show ?thesis by blast
next
  case False
  obtain A' K'
    where A': "A' \<subseteq> A" "A' \<noteq> {}" "0 < K'" "K' \<le> K"
      and A'_card: "\<And>C. C \<subseteq> G \<Longrightarrow> finite C \<Longrightarrow> card (sumset A' (sumset B C)) \<le> K' * real (card(sumset A' C))"
    by (metis A B Plu_2_2 K False)
  with A have "A' \<subseteq> G" by blast
  have *: "card (sumset A' (sumset_iterated B (Suc r))) \<le> K' * card (sumset A' (sumset_iterated B r))"
          (is "?lhs \<le> ?rhs")
    for r
  proof -
    have "?lhs = card (sumset A' (sumset B (sumset_iterated B r)))"
      using that by (simp add: sumset_iterated_r)
    also have "\<dots> \<le> ?rhs"
      using A'_card B finite_sumset_iterated sumset_iterated_subset_carrier by meson
    finally show ?thesis .
  qed
  have **: "card (sumset A' (sumset_iterated B r)) \<le> K'^r * real (card A')" for r
  proof (induction r)
    case 0
    with \<open>A' \<subseteq> G\<close> show ?case
      by (simp add: Int_absorb2)
  next
    case (Suc r)
    then show ?case
      by (smt (verit) "*" \<open>0 < K'\<close> mult.commute mult.left_commute mult_le_cancel_left_pos power_Suc)
  qed
  show thesis
  proof
    show "real (card (sumset A' (sumset_iterated B r))) \<le> K ^ r * real (card A')" for r
      by (meson "**" A' order_trans less_eq_real_def mult_right_mono of_nat_0_le_iff power_mono)
  qed (use A' in auto)
qed

text\<open>The following Corollary of the above is an important special case,
also referred to as the original version of Pl\"{u}nnecke's inequality first shown by Pl\"{u}nnecke. \<close>

lemma Cor_Plu_2_3_Pluennecke_ineq:
  assumes K: "card (sumset A B) \<le> K * real (card A)"
    and   A: "finite A" "A \<subseteq> G" "A \<noteq> {}"
    and   B: "finite B" "B \<subseteq> G"
  shows "real (card (sumset_iterated B r)) \<le> K ^ r * real (card A)"
proof-
  obtain A' where *:"A' \<subseteq> A" "A' \<noteq> {}"
    "card (sumset A' (sumset_iterated B r)) \<le> K^r * real (card A')"
    using assms Cor_Plu_2_3 by metis
  with assms have  **: "card (sumset_iterated B r) \<le> card (sumset A' (sumset_iterated B r))"
    by (meson card_le_sumset finite_subset finite_sumset_iterated subset_empty subset_iff sumset_iterated_subset_carrier)
  with * show ?thesis
    by (smt (verit, best) A(1) K card_mono mult_left_mono of_nat_0_le_iff of_nat_le_iff zero_le_mult_iff zero_le_power)
qed

text \<open>Special case where @{term "B=A"}\<close>
lemma Cor_Plu_2_3_1:
  assumes K: "card (sumset A A) \<le> K * real (card A)"
    and   A: "finite A" "A \<subseteq> G" "A \<noteq> {}"
  shows "card (sumset_iterated A r) \<le> K^r * real (card A)"
proof -
  have "K > 0"
    by (meson A K Plu_2_2 less_le_trans)
  obtain A' where A': "A' \<subseteq> A" "A' \<noteq> {}"
    and A'_card: "\<And>r. card (sumset A' (sumset_iterated A r)) \<le> K^r * real (card A')"
    by (meson A Cor_Plu_2_3 K)
  with A obtain a where "a \<in> A'" "a \<in> G" "finite A'"
    by (metis ex_in_conv finite_subset subset_iff)
  then have "card (sumset_iterated A r) \<le> card (sumset A' (sumset_iterated A r))"
    using A card_le_sumset finite_sumset_iterated sumset_iterated_subset_carrier by meson
  also have "\<dots> \<le> K^r * real (card A')"
    using A'_card by meson
  also have "\<dots> \<le> K^r * real (card A)"
    by (simp add: \<open>A' \<subseteq> A\<close> \<open>finite A\<close> \<open>0 < K\<close> card_mono)
  finally show ?thesis
    by linarith
qed

text \<open>Special case where @{term "B=-A"}\<close>
lemma Cor_Plu_2_3_2:
  assumes K: "card (differenceset A A) \<le> K * real (card A)"
    and   A: "finite A" "A \<subseteq> G" "A \<noteq> {}"
  shows "card (sumset_iterated A r) \<le> K^r * real (card A)"
proof -
  have "card A > 0"
    by (simp add: A card_gt_0_iff)
  with K have "K \<ge> 0"
    by (smt (verit, del_insts) of_nat_0_less_iff of_nat_less_0_iff zero_le_mult_iff)
  obtain A' where A': "A' \<subseteq> A" "A' \<noteq> {}"
    and A'_card: "\<And>r. card (sumset A' (sumset_iterated (minusset A) r)) \<le> K^r * real (card A')"
    by (metis A Cor_Plu_2_3 assms(1) card_eq_0_iff card_minusset' minusset_subset_carrier)
  with A obtain a where "a \<in> A'" "a \<in> G" "finite A'"
    by (metis ex_in_conv finite_subset subset_iff)
  then have "card (sumset_iterated A r) \<le> card (sumset A' (sumset_iterated (minusset A) r))"
    by (metis A(1) card_le_sumset card_sumset_iterated_minusset finite_minusset finite_sumset_iterated sumset_iterated_subset_carrier)
  also have "\<dots> \<le> K^r * real (card A')"
    using A'_card by meson
  also have "\<dots> \<le> K^r * real (card A)"
    by (simp add: \<open>A' \<subseteq> A\<close> \<open>finite A\<close> \<open>0 \<le> K\<close> card_mono mult_left_mono)
  finally show ?thesis
    by linarith
qed

text \<open>The following result is known as the Pl\"{u}nnecke-Ruzsa inequality (Theorem 2.5
in Gowers's notes). The proof will make use of the Ruzsa triangle inequality.\<close>

theorem Pluennecke_Ruzsa_ineq:
  assumes K:  "card (sumset A B) \<le> K * real (card A)"
    and   A: "finite A" "A \<subseteq> G" "A \<noteq> {}"
    and   B: "finite B" "B \<subseteq> G"
    and "0 < r" "0 < s"
  shows "card (differenceset (sumset_iterated B r) (sumset_iterated B s)) \<le> K^(r+s) * real(card A)"
proof -
  have "card A > 0"
    by (simp add: A card_gt_0_iff)
  with K have "K \<ge> 0"
    by (smt (verit, del_insts) of_nat_0_less_iff of_nat_less_0_iff zero_le_mult_iff)
  obtain A' where A': "A' \<subseteq> A" "A' \<noteq> {}"
    and A'_le: "\<And>r. card (sumset A' (sumset_iterated B r)) \<le> K^r * real (card A')"
    using  Cor_Plu_2_3 assms by metis
  define C where "C \<equiv> minusset A'"
  have "minusset C = A'" and "C \<noteq>{}" and cardA: "card A' \<le> card A" and cardC: "card C = card A'"
    using A' A card_mono by (auto simp: C_def card_minusset' Int_absorb2)
  then have cardCA: "card C \<le> card A" by linarith
  have "\<And>r. card (differenceset C (sumset_iterated B r)) \<le> K^r * real (card A')"
    using A'_le C_def card_minusset' diff_minus_set sumset_subset_carrier by presburger
  then have r: "card (differenceset C (sumset_iterated B r)) \<le> K^r * real (card C)"
    and  s: "card (differenceset C (sumset_iterated B s)) \<le> K^s * real (card C)"
    using cardC by presburger+
  have "card C > 0"
    by (metis A' \<open>finite A\<close> cardC card_gt_0_iff finite_subset)
  moreover have "C \<subseteq> G"
    by (simp add: C_def minusset_subset_carrier)
  ultimately have "card C * card (differenceset (sumset_iterated B r) (sumset_iterated B s))
        \<le> card (differenceset C (sumset_iterated B r)) *
           card (differenceset C (sumset_iterated B s))"
    by (meson Ruzsa_triangle_ineq1 B card_gt_0_iff finite_sumset_iterated sumset_iterated_subset_carrier)
  also have "\<dots> \<le> K^(r+s) * card C * card C"
    using mult_mono [OF r s] \<open>0 \<le> K\<close> by (simp add: power_add field_simps)
  finally have "card (differenceset (sumset_iterated B r) (sumset_iterated B s)) \<le> K^(r+s) * card C"
    using \<open>card C > 0\<close> by (simp add: field_simps)
  then show ?thesis
    by (smt (verit, ccfv_SIG) \<open>0 \<le> K\<close> cardA cardC mult_left_mono of_nat_mono zero_le_power)
qed

text \<open>The following is an alternative version of the Pl\"{u}nnecke-Ruzsa inequality (Theorem 2.1
in Gowers's notes).\<close>

theorem Pluennecke_Ruzsa_ineq_alt:
  assumes "finite A" "A \<subseteq> G"
    and "card (sumset A A) \<le> K * real (card A)" "r > 0" "s > 0"
  shows "card (differenceset (sumset_iterated A r) (sumset_iterated A s)) \<le> K^(r+s) * real(card A)"
proof (cases "A = {}")
  case True
  then have "sumset_iterated A r = {}" if "r>0" for r
    using sumset_iterated_empty that by force
  with assms show ?thesis
    by (auto simp: True)
next
  case False
  with assms Pluennecke_Ruzsa_ineq show ?thesis by presburger
qed

theorem Pluennecke_Ruzsa_ineq_alt_2:
  assumes "finite A" "A \<subseteq> G"
    and "card (differenceset A A) \<le> K * real (card A)" "r > 0" "s > 0"
  shows "card (differenceset (sumset_iterated A r) (sumset_iterated A s)) \<le> K^(r+s) * real(card A)"
proof (cases "A = {}")
  case True
  then have "sumset_iterated A r = {}" if "r>0" for r
    using sumset_iterated_empty that by force
  with assms show ?thesis
    by (auto simp: True)
next
  case False
  with assms Pluennecke_Ruzsa_ineq show ?thesis
    by (smt (verit, ccfv_threshold) card_minusset' differenceset_commute finite_minusset
        minusset_distrib_sum minusset_iterated_minusset minusset_subset_carrier)
qed

end

subsection \<open>Supplementary material on sumsets for sets of integers: basic inequalities\<close>

lemma moninv_int: "monoid.invertible UNIV (+) 0 u" for u::int
  using monoid.invertibleI [where v = "-u"] by (simp add: Group_Theory.monoid_def)

interpretation int: additive_abelian_group UNIV "(+)" "0::int"
  by unfold_locales (use moninv_int in auto)

lemma card_sumset_geq1:
  assumes A: "A \<noteq> {}" "finite A" and B: "B \<noteq> {}" "finite B"
  shows "card(int.sumset A B) \<ge> (card A) + (card B) - 1"
  using A
proof (induction "card A" arbitrary: A)
  case (Suc n)
  define a where "a = Max A"
  define A' where "A' \<equiv> A - {a}"
  then obtain a: "a \<in> A" "A' = A - {a}" "finite A'" "a \<notin> A'" and A: "A = insert a A'"
    using Max_in Suc a_def by blast
  with Suc have n: "card A' = n"
    by (metis card_Diff_singleton diff_Suc_Suc minus_nat.diff_0 One_nat_def)
  show ?case
  proof (cases "A' = {}")
    case True
    then show ?thesis
      by (simp add: A B(2) int.card_sumset_singleton_eq int.sumset_commute)
  next
    case False
    have "a + Max B \<notin> int.sumset A' B"
      using \<open>finite A\<close> \<open>finite B\<close>
      by (smt (verit, best) DiffE Max_ge a a_def int.sumset.cases singleton_iff)
    then have *: "\<not> int.sumset A' B \<union> (+) a ` B \<subseteq> int.sumset A' B"
      using B Max_in by blast
    have "card A + card B - 1 \<le> Suc (card (int.sumset A' B))"
      using Suc False A a using le_diff_conv by force
    also have "\<dots> \<le> card (int.sumset A' B \<union> (+) a ` B)"
      using a B
      by (metis "*" card_seteq finite_Un finite_imageI int.finite_sumset not_less_eq_eq sup_ge1)
    also have "\<dots> \<le> card (int.sumset A B)"
    proof (rule card_mono)
      show "finite (int.sumset A B)"
        using B Suc.prems int.finite_sumset by blast
      show "int.sumset A' B \<union> (+) a ` B \<subseteq> int.sumset A B"
        using A by (force simp: int.sumset)
    qed
    finally show ?thesis .
  qed
qed auto

lemma card_sumset_geq2:
  shows "card(int.sumset A A) \<ge> 2 * (card A) - 1"
  using card_sumset_geq1 [of A]
  by (metis mult.commute Nat.add_0_right card_eq_0_iff diff_0_eq_0 le0 mult_2_right)

end


theory AteDefs
imports "../HOModel"
begin

section {* Verification of the \ate{} Consensus algorithm *}

text {*
  Algorithm \ate{} is presented in~\cite{biely:tolerating}. Like \ute{},
  it is an uncoordinated algorithm that tolerates value faults, and it
  is parameterized by values $T$, $E$, and $\alpha$ that serve a similar
  function as in \ute{}, allowing the algorithm to be adapted to the
  characteristics of different systems. \ate{} can be understood as a
  variant of \emph{OneThirdRule} tolerating Byzantine faults.

  We formalize in Isabelle the correctness proof of the algorithm that
  appears in~\cite{biely:tolerating}, using the framework of theory
  @{text HOModel}.
*}

subsection {* Model of the Algorithm *}

text {*
  We begin by introducing an anonymous type of processes of finite
  cardinality that will instantiate the type variable @{text "'proc"}
  of the generic HO model.
*}

typedecl Proc -- {* the set of processes *}
axiomatization where Proc_finite: "OFCLASS(Proc, finite_class)"
instance Proc :: finite by (rule Proc_finite)

abbreviation
  "N \<equiv> card (UNIV::Proc set)"   -- {* number of processes *}

text {* The following record models the local state of a process. *}

record 'val pstate =
  x :: "'val"              -- {* current value held by process *}
  decide :: "'val option"  -- {* value the process has decided on, if any *}

text {*
  The @{text x} field of the initial state is unconstrained, but no
  decision has yet been taken.
*}

definition Ate_initState where
  "Ate_initState p st \<equiv> (decide st = None)"

text {*
  The following locale introduces the parameters used for the \ate{}
  algorithm and their constraints~\cite{biely:tolerating}.
*}

locale ate_parameters =
  fixes \<alpha>::nat and T::nat and E::nat
  assumes TNaE:"T \<ge> 2*(N + 2*\<alpha> - E)"
      and TltN:"T < N"
      and EltN:"E < N"

begin

text {* The following are consequences of the assumptions on the parameters. *}

lemma majE: "2 * (E - \<alpha>) \<ge> N"
using TNaE TltN by auto

lemma Egta: "E > \<alpha>"
using majE EltN by auto

lemma Tge2a: "T \<ge> 2 * \<alpha>"
using TNaE EltN by auto

text {*
  At every round, each process sends its current @{text x}.
  If it received more than @{text T} messages, it selects the smallest value
  and store it in @{text x}. As in algorithm \emph{OneThirdRule}, we
  therefore require values to be linearly ordered.

  If more than @{text E} messages holding the same value are received,
  the process decides that value.
*}

definition mostOftenRcvd where
  "mostOftenRcvd (msgs::Proc \<Rightarrow> 'val option) \<equiv>
   {v. \<forall>w. card {qq. msgs qq = Some w} \<le> card {qq. msgs qq = Some v}}"

definition
  Ate_sendMsg :: "nat \<Rightarrow> Proc \<Rightarrow> Proc \<Rightarrow> 'val pstate \<Rightarrow> 'val"
where
  "Ate_sendMsg r p q st \<equiv> x st"

definition
  Ate_nextState :: "nat \<Rightarrow> Proc \<Rightarrow> ('val::linorder) pstate \<Rightarrow> (Proc \<Rightarrow> 'val option)
                        \<Rightarrow> 'val pstate \<Rightarrow> bool"
where
  "Ate_nextState r p st msgs st' \<equiv>
     (if card {q. msgs q \<noteq> None} > T
      then x st' = Min (mostOftenRcvd msgs)
      else x st' = x st)
   \<and> (   (\<exists>v. card {q. msgs q = Some v} > E  \<and> decide st' = Some v)
       \<or> \<not> (\<exists>v. card {q. msgs q = Some v} > E)
         \<and> decide st' = decide st)"

subsection {* Communication Predicate for \ate{} *}

text {*
  Following~\cite{biely:tolerating}, we now define the communication
  predicate for the \ate{} algorithm. The round-by-round predicate
  requires that no process may receive more than @{text "\<alpha>"} corrupted
  messages at any round.
*}
definition Ate_commPerRd where
  "Ate_commPerRd HOrs SHOrs \<equiv>
   \<forall>p. card (HOrs p - SHOrs p) \<le> \<alpha>"

text {*
  The global communication predicate stipulates the three following
  conditions:
  \begin{itemize}
  \item for every process @{text p} there are infinitely many rounds
    where @{text p} receives more than @{text T} messages,
  \item for every process @{text p} there are infinitely many rounds
    where @{text p} receives more than @{text E} uncorrupted messages,
  \item and there are infinitely many rounds in which more than
    @{text "E - \<alpha>"} processes receive uncorrupted messages from the
    same set of processes, which contains more than @{text T} processes.
  \end{itemize}
*}
definition
  Ate_commGlobal where
  "Ate_commGlobal HOs SHOs \<equiv>
     (\<forall>r p. \<exists>r' > r. card (HOs r' p) > T)
   \<and> (\<forall>r p.  \<exists>r' > r. card (SHOs r' p \<inter> HOs r' p) > E)
   \<and> (\<forall>r. \<exists>r' > r. \<exists>\<pi>1 \<pi>2.
        card \<pi>1 > E - \<alpha>
      \<and> card \<pi>2 > T
      \<and> (\<forall>p \<in> \<pi>1. HOs r' p = \<pi>2 \<and> SHOs r' p \<inter> HOs r' p = \<pi>2))"

subsection {* The \ate{} Heard-Of Machine *}

text {*
  We now define the non-coordinated SHO machine for the \ate{} algorithm
  by assembling the algorithm definition and its communication-predicate.
*}

definition Ate_SHOMachine where
  "Ate_SHOMachine = \<lparr>
    CinitState =  (\<lambda> p st crd. Ate_initState p (st::('val::linorder) pstate)),
    sendMsg =  Ate_sendMsg,
    CnextState = (\<lambda> r p st msgs crd st'. Ate_nextState r p st msgs st'),
    SHOcommPerRd = (Ate_commPerRd:: Proc HO \<Rightarrow> Proc HO \<Rightarrow> bool),
    SHOcommGlobal = Ate_commGlobal
   \<rparr>"

abbreviation
  "Ate_M \<equiv> (Ate_SHOMachine::(Proc, 'val::linorder pstate, 'val) SHOMachine)"

end   -- {* locale @{text "ate_parameters"} *}

end   (* theory AteDefs *)


(*  Title:      Subgroup Conjugation
    Author:     Jakob von Raumer, Karlsruhe Institute of Technology
    Maintainer: Jakob von Raumer <jakob.raumer at student.kit.edu>
*)

theory SubgroupConjugation
imports GroupAction
begin

section {* Conjugation of Subgroups and Cosets *}

text {* This theory examines properties of the conjugation of subgroups
of a fixed group as a group action *}

subsection {* Definitions and Preliminaries *}

text {* We define the set of all subgroups of @{term G} which have a certain
cardinality. @{term G} will act on those sets. Afterwards some theorems which
are already available for right cosets are dualized into statements about
left cosets.*}

lemma (in subgroup) subgroup_of_subset:
  assumes G:"group G"
  assumes PH:"H \<subseteq> K"
  assumes KG:"subgroup K G"
  shows "subgroup H (G\<lparr>carrier := K\<rparr>)"
using assms subgroup_def group.subgroup_inv_equality m_inv_closed by fastforce

context group
begin

definition subgroups_of_size ::"nat \<Rightarrow> _"
  where "subgroups_of_size p = {H. subgroup H G \<and> card H = p}"

lemma lcosI: "[| h \<in> H; H \<subseteq> carrier G; x \<in> carrier G|] ==> x \<otimes> h \<in> x <# H"
  by (auto simp add: l_coset_def)

lemma lcoset_join2:
  assumes H:"subgroup H G"
  assumes g:"g \<in> H"
  shows "g <# H = H"
proof auto
  fix x
  assume x:"x \<in> g <# H"
  then obtain h where h:"h \<in> H" "x = g \<otimes> h" unfolding l_coset_def by auto
  with g H show "x \<in> H" by (metis subgroup.m_closed)
next
  fix x
  assume x:"x \<in> H"
  with g H have "inv g \<otimes> x \<in> H" by (metis subgroup.m_closed subgroup.m_inv_closed)
  with x g H show "x \<in> g <# H" by (metis is_group subgroup.lcos_module_rev subgroup.mem_carrier)
qed

lemma cardeq_rcoset:
  assumes "finite (carrier G)"
  assumes "M \<subseteq> carrier G"
  assumes "g \<in> carrier G"
  shows "card (M #> g) = card  M"
proof -
  have "M #> g \<in> rcosets M" by (metis assms(2) assms(3) rcosetsI)
  thus "card (M #> g) = card M" by (metis assms(1) assms(2) card_cosets_equal)
qed

lemma cardeq_lcoset:
  assumes "finite (carrier G)"
  assumes M:"M \<subseteq> carrier G"
  assumes g:"g \<in> carrier G"
  shows "card (g <# M) = card  M"
proof -
  have "bij_betw (\<lambda>m. g \<otimes> m) M (g <# M)"
  proof(auto simp add: bij_betw_def)
    show "inj_on (op \<otimes> g) M"
    proof(rule inj_onI)
        from g have invg:"inv g \<in> carrier G" by (rule inv_closed)
        fix x y
        assume x:"x \<in> M" and y:"y \<in> M"
        with M have xG:"x \<in> carrier G" and yG:"y \<in> carrier G" by auto
        assume "g \<otimes> x = g \<otimes> y"
        hence "(inv g) \<otimes> (g \<otimes> x) = (inv g) \<otimes> (g \<otimes> y)" by simp
        with g invg xG yG have "(inv g \<otimes> g) \<otimes> x = (inv g \<otimes> g) \<otimes> y" by (metis m_assoc)
        with g invg xG yG show  "x = y" by simp
    qed
  next
    fix x
    assume "x \<in> M"
    thus "g \<otimes> x \<in> g <# M" unfolding l_coset_def by auto
  next
    fix x
    assume x:"x \<in> g <# M"
    then obtain m where "x = g \<otimes> m" "m \<in> M" unfolding l_coset_def by auto
    thus "x \<in> op \<otimes> g ` M" by simp
  qed
  thus "card (g <# M) = card M" by (metis bij_betw_same_card)
qed

subsection {* Conjugation is a group action *}

text {* We will now prove that conjugation acts on the subgroups
of a certain group. A large part of this proof consists of showing that
the conjugation of a subgroup with a group element is, again, a subgroup. *}

lemma conjugation_subgroup:
  assumes HG:"subgroup H G"
  assumes gG:"g \<in> carrier G"
  shows "subgroup (g <# (H #> inv g)) G"
proof
  from gG have "inv g \<in> carrier G" by (rule inv_closed)
  with HG have "(H #> inv g) \<subseteq> carrier G" by (metis r_coset_subset_G subgroup_imp_subset)
  with gG show "g <# (H #> inv g) \<subseteq> carrier G" by (metis l_coset_subset_G)
next
  from gG have invgG:"inv g \<in> carrier G" by (metis inv_closed)
  with HG have lcosSubset:"(H #> inv g) \<subseteq> carrier G" by (metis r_coset_subset_G subgroup_imp_subset)
  fix x y
  assume x:"x \<in> g <# (H #> inv g)" and y:"y \<in> g <# (H #> inv g)"
  then obtain x' y' where x':"x' \<in> H #> inv g" "x = g \<otimes> x'" and y':"y' \<in> H #> inv g" "y = g \<otimes> y'" unfolding l_coset_def by auto
  then obtain hx hy where hx:"hx \<in> H" "x' = hx \<otimes> inv g" and hy:"hy \<in> H" "y' = hy \<otimes> inv g" unfolding r_coset_def by auto
  with x' y' have x2:"x = g \<otimes> (hx \<otimes> inv g)" and y2:"y = g \<otimes> (hy \<otimes> inv g)" by auto
  hence "x \<otimes> y = (g \<otimes> (hx \<otimes> inv g)) \<otimes> (g \<otimes> (hy \<otimes> inv g))" by simp
  also from hx hy HG have hxG:"hx \<in> carrier G" and hyG:"hy \<in> carrier G" by (metis subgroup.mem_carrier)+
  with gG hy x2 invgG have "(g \<otimes> (hx \<otimes> inv g)) \<otimes> (g \<otimes> (hy \<otimes> inv g)) = g \<otimes> hx \<otimes> (inv g \<otimes> g) \<otimes> hy \<otimes> inv g" by (metis m_assoc m_closed)
  also from invgG gG have "... = g \<otimes> hx \<otimes> \<one> \<otimes> hy \<otimes> inv g" by simp
  also from gG hxG have "... = g \<otimes> hx \<otimes> hy \<otimes> inv g" by (metis m_closed r_one)
  also from gG hxG invgG have "... = g \<otimes> ((hx \<otimes> hy) \<otimes> inv g)" by (metis gG hxG hyG invgG m_assoc m_closed)
  finally have xy:"x \<otimes> y = g \<otimes> (hx \<otimes> hy \<otimes> inv g)".
  from hx hy HG have "hx \<otimes> hy \<in> H" by (metis subgroup.m_closed)
  with invgG HG have "(hx \<otimes> hy) \<otimes> inv g \<in> H #> inv g" by (metis rcosI subgroup_imp_subset)
  with gG lcosSubset have "g \<otimes> (hx \<otimes> hy \<otimes> inv g) \<in> g <# (H #> inv g)" by (metis lcosI)
  with xy show "x \<otimes> y \<in> g <# (H #> inv g)" by simp
next
  from gG have invgG:"inv g \<in> carrier G" by (metis inv_closed)
  with HG have lcosSubset:"(H #> inv g) \<subseteq> carrier G" by (metis r_coset_subset_G subgroup_imp_subset)
  from HG have "\<one> \<in> H" by (rule subgroup.one_closed)
  with invgG HG have  "\<one> \<otimes> inv g \<in> H #> inv g" by (metis rcosI subgroup_imp_subset)
  with gG lcosSubset have "g \<otimes> (\<one> \<otimes> inv g) \<in> g <# (H #> inv g)" by (metis lcosI)
  with gG invgG show "\<one> \<in> g <# (H #> inv g)" by simp
next
  from gG have invgG:"inv g \<in> carrier G" by (metis inv_closed)
  with HG have lcosSubset:"(H #> inv g) \<subseteq> carrier G" by (metis r_coset_subset_G subgroup_imp_subset)
  fix x
  assume "x \<in> g <# (H #> inv g)"
  then obtain x' where x':"x' \<in> H #> inv g" "x = g \<otimes> x'" unfolding l_coset_def by auto
  then obtain hx where hx:"hx \<in> H" "x' = hx \<otimes> inv g"  unfolding r_coset_def by auto
  with HG have invhx:"inv hx \<in> H" by (metis subgroup.m_inv_closed)
  from x' hx have "inv x = inv (g \<otimes> (hx \<otimes> inv g))" by simp
  also from x' hx HG gG invgG have "... = inv (inv g) \<otimes> inv hx \<otimes> inv g" by (metis calculation in_mono inv_mult_group lcosSubset subgroup.mem_carrier)
  also from gG have "... = g \<otimes> inv hx \<otimes> inv g" by simp
  also from gG invgG invhx HG have "... = g \<otimes> (inv hx \<otimes> inv g)" by (metis m_assoc subgroup.mem_carrier)
  finally have invx:"inv x = g \<otimes> (inv hx \<otimes> inv g)".
  with invhx invgG HG have "(inv hx) \<otimes> inv g \<in> H #> inv g" by (metis rcosI subgroup_imp_subset)
  with gG lcosSubset have "g \<otimes> (inv hx \<otimes> inv g) \<in> g <# (H #> inv g)" by (metis lcosI)
  with invx show "inv x \<in> g <# (H #> inv g)" by simp
qed

definition conjugation_action::"nat \<Rightarrow> _"
  where "conjugation_action p = (\<lambda>g\<in>carrier G. \<lambda>P\<in>subgroups_of_size p. g <# (P #> inv g))"

lemma conjugation_is_size_invariant:
  assumes fin:"finite (carrier G)"
  assumes P:"P \<in> subgroups_of_size p"
  assumes g:"g \<in> carrier G"
  shows "conjugation_action p g P \<in> subgroups_of_size p"
proof -
  from g have invg:"inv g \<in> carrier G" by (metis inv_closed)
  from P have PG:"subgroup P G" and card:"card P = p" unfolding subgroups_of_size_def by simp+
  hence PsubG:"P \<subseteq> carrier G" by (metis subgroup_imp_subset)
  hence PinvgsubG:"P #> inv g \<subseteq> carrier G" by (metis invg r_coset_subset_G)
  have " g <# (P #> inv g) \<in> subgroups_of_size p"
  proof(auto simp add:subgroups_of_size_def)
    show "subgroup (g <# (P #> inv g)) G" by (metis g PG conjugation_subgroup)
  next
    from card PsubG fin invg have "card (P #> inv g) = p" by (metis cardeq_rcoset)
    with g PinvgsubG fin show "card (g <# (P #> inv g)) = p" by (metis cardeq_lcoset)
  qed
  with P g show ?thesis unfolding conjugation_action_def by simp
qed

lemma conjugation_is_Bij:
  assumes fin:"finite (carrier G)"
  assumes g:"g \<in> carrier G"
  shows "conjugation_action p g \<in> Bij (subgroups_of_size p)"
proof -
  from g have invg:"inv g \<in> carrier G" by (rule inv_closed)
  from g have "conjugation_action p g \<in> extensional (subgroups_of_size p)" unfolding conjugation_action_def by simp
  moreover have "bij_betw (conjugation_action p g) (subgroups_of_size p) (subgroups_of_size p)"
  proof(auto simp add:bij_betw_def)
    show "inj_on (conjugation_action p g) (subgroups_of_size p)"
    proof(rule inj_onI)
      fix U V
      assume U:"U \<in> subgroups_of_size p" and V:"V \<in> subgroups_of_size p"
      hence subsetG:"U \<subseteq> carrier G" "V \<subseteq> carrier G" unfolding subgroups_of_size_def by (metis (lifting) mem_Collect_eq subgroup_imp_subset)+
      hence subsetL:"U #> inv g \<subseteq> carrier G" "V #> inv g \<subseteq> carrier G" by (metis invg r_coset_subset_G)+
      assume "conjugation_action p g U = conjugation_action p g V"
      with g U V have "g <# (U #> inv g) = g <# (V #> inv g)" unfolding conjugation_action_def by simp
      hence "(inv g) <# (g <# (U #> inv g)) = (inv g) <# (g <# (V #> inv g))" by simp
      hence "(inv g \<otimes> g) <# (U #> inv g) = (inv g \<otimes> g) <# (V #> inv g)" by (metis g invg lcos_m_assoc r_coset_subset_G subsetG)
      hence "\<one> <# (U #> inv g) = \<one> <# (V #> inv g)" by (metis g l_inv)
      hence "U #> inv g = V #> inv g" by (metis subsetL lcos_mult_one)
      hence "(U #> inv g) #> g = (V #> inv g) #> g" by simp
      hence "U #> (inv g \<otimes> g) = V #> (inv g \<otimes> g)" by (metis coset_mult_assoc g inv_closed subsetG)
      hence "U #> \<one> = V #> \<one>" by (metis g l_inv)
      thus "U = V" by (metis coset_mult_one subsetG)
    qed
  next
    fix P
    assume "P \<in> subgroups_of_size p"
    thus "conjugation_action p g P \<in> subgroups_of_size p" by (metis fin g conjugation_is_size_invariant)
  next
    fix P
    assume P:"P \<in> subgroups_of_size p"
    with invg have "conjugation_action p (inv g) P \<in> subgroups_of_size p" by (metis fin invg conjugation_is_size_invariant)
    with invg P have "(inv g) <# (P #> (inv (inv g))) \<in> subgroups_of_size p" unfolding conjugation_action_def by simp
    hence 1:"(inv g) <# (P #> g) \<in> subgroups_of_size p" by (metis g inv_inv)
    have "g <# (((inv g) <# (P #> g)) #> inv g) = (\<Union>p \<in> P. {g \<otimes> (inv g \<otimes> (p \<otimes> g) \<otimes> inv g)})" unfolding r_coset_def l_coset_def by (simp add:m_assoc)
    also from P have PG:"P \<subseteq> carrier G" unfolding subgroups_of_size_def by (auto simp add:subgroup_imp_subset)
    have "\<forall>p \<in> P.  g \<otimes> (inv g \<otimes> (p \<otimes> g) \<otimes> inv g) = p"
    proof(auto)
      fix p
      assume "p \<in> P"
      with PG have p:"p \<in> carrier G"..
      with g invg have "g \<otimes> (inv g \<otimes> (p \<otimes> g) \<otimes> inv g) = (g \<otimes> inv g) \<otimes> p \<otimes> (g \<otimes> inv g)" by (metis m_assoc m_closed)
      also with g invg g p have "... = p" by (metis l_one r_inv r_one)
      finally show "g \<otimes> (inv g \<otimes> (p \<otimes> g) \<otimes> inv g) = p".
    qed
    hence "(\<Union>p \<in> P. {g \<otimes> (inv g \<otimes> (p \<otimes> g) \<otimes> inv g)}) = P" by simp
    finally have "g <# (((inv g) <# (P #> g)) #> inv g) = P".
    with 1 have "P \<in> (\<lambda>P. g <# (P #> inv g)) ` subgroups_of_size p" by auto
    with P g show "P \<in> conjugation_action p g ` subgroups_of_size p" unfolding conjugation_action_def by simp
  qed
  ultimately show ?thesis unfolding BijGroup_def Bij_def by simp
qed

lemma lr_coset_assoc:
  assumes g:"g \<in> carrier G"
  assumes h:"h \<in> carrier G"
  assumes P:"P \<subseteq> carrier G"
  shows "g <# (P #> h) = (g <# P) #> h"
proof(auto)
  fix x
  assume "x \<in> g <# (P #> h)"
  then obtain p where "p \<in> P" and p:"x = g \<otimes> (p \<otimes> h)" unfolding l_coset_def r_coset_def by auto
  with P have "p \<in> carrier G" by auto
  with g h p have "x = (g \<otimes> p) \<otimes> h" by (metis m_assoc)
  with `p \<in> P` show "x \<in> (g <# P) #> h" unfolding l_coset_def r_coset_def by auto
next
  fix x
  assume "x \<in> (g <# P) #> h"
  then obtain p where "p \<in> P" and p:"x = (g \<otimes> p) \<otimes> h" unfolding l_coset_def r_coset_def by auto
  with P have "p \<in> carrier G" by auto
  with g h p have "x = g \<otimes> (p \<otimes> h)" by (metis m_assoc)
  with `p \<in> P` show "x \<in> g <# (P #> h)" unfolding l_coset_def r_coset_def by auto
qed

theorem acts_on_subsets:
  assumes fin:"finite (carrier G)"
  shows "group_action G (conjugation_action p) (subgroups_of_size p)"
unfolding group_action_def group_action_axioms_def group_hom_def group_hom_axioms_def hom_def
apply(auto simp add:is_group group_BijGroup)
proof -
  fix g
  assume g:"g \<in> carrier G"
  with fin show "conjugation_action p g \<in> carrier (BijGroup (subgroups_of_size p))"
    unfolding BijGroup_def by (metis conjugation_is_Bij partial_object.select_convs(1))
next
  fix x y
  assume x:"x \<in> carrier G" and y:"y \<in> carrier G"
  hence invx:"inv x \<in> carrier G" and invy:"inv y \<in> carrier G" by (metis inv_closed)+
  from x y have xyG:"x \<otimes> y \<in> carrier G" by (metis m_closed)
  def conjx \<equiv> "conjugation_action p x"
  def conjy \<equiv> "conjugation_action p y"
  from fin x have xBij:"conjx \<in> Bij (subgroups_of_size p)" unfolding conjx_def by (metis conjugation_is_Bij)
  from fin y have yBij:"conjy \<in> Bij (subgroups_of_size p)" unfolding conjy_def by (metis conjugation_is_Bij)
  have "conjx \<otimes>\<^bsub>BijGroup (subgroups_of_size p)\<^esub> conjy
    = (\<lambda>g\<in>Bij (subgroups_of_size p). restrict (compose (subgroups_of_size p) g) (Bij (subgroups_of_size p))) conjx conjy" unfolding BijGroup_def by simp
  also from xBij yBij have "... = compose (subgroups_of_size p) conjx conjy" by simp
  also have "... = (\<lambda>P\<in>subgroups_of_size p. conjx (conjy P))" by (metis compose_def)
  also have "... = (\<lambda>P\<in>subgroups_of_size p. x \<otimes> y <# (P #> inv (x \<otimes> y)))"
  proof(rule restrict_ext)
    fix P
    assume P:"P \<in> subgroups_of_size p"
    hence PG:"P \<subseteq> carrier G" unfolding subgroups_of_size_def by (auto simp:subgroup_imp_subset)
    with y have yPG:"y <# P \<subseteq> carrier G" by (metis l_coset_subset_G)
    from x y have invxyG:"inv (x \<otimes> y) \<in> carrier G" and xyG:"x \<otimes> y \<in> carrier G" using inv_closed m_closed by auto
    from yBij have "conjy ` subgroups_of_size p = subgroups_of_size p" unfolding Bij_def bij_betw_def by simp
    with P have conjyP:"conjy P \<in> subgroups_of_size p" unfolding Bij_def bij_betw_def by (metis (full_types) imageI)
    with x y P have "conjx (conjy P) = x <# ((y <# (P #> inv y)) #> inv x)" unfolding conjy_def conjx_def conjugation_action_def by simp
    also from y invy PG have "... = x <# (((y <# P) #> inv y) #> inv x)" by (metis lr_coset_assoc)
    also from PG invx invy y have "... = x <# ((y <# P) #> (inv y \<otimes> inv x))" by (metis coset_mult_assoc yPG)
    also from x y have "... = x <# ((y <# P) #> inv (x \<otimes> y))" by (metis inv_mult_group)
    also from invxyG x yPG have "... = (x <# (y <# P)) #> inv (x \<otimes> y)" by (metis lr_coset_assoc)
    also from x y PG have "... = ((x \<otimes> y) <# P) #> inv (x \<otimes> y)" by (metis lcos_m_assoc)
    also from xyG invxyG PG have "... = (x \<otimes> y) <# (P #> inv (x \<otimes> y))" by (metis lr_coset_assoc)
    finally show "conjx (conjy P) = x \<otimes> y <# (P #> inv (x \<otimes> y))".
  qed
  finally have "conjx \<otimes>\<^bsub>BijGroup (subgroups_of_size p)\<^esub> conjy = (\<lambda>P\<in>subgroups_of_size p. x \<otimes> y <# (P #> inv (x \<otimes> y)))".
  with xyG show "conjugation_action p (x \<otimes> y)
    = conjugation_action p x \<otimes>\<^bsub>BijGroup (subgroups_of_size p)\<^esub> conjugation_action p y"
    unfolding conjx_def conjy_def conjugation_action_def by simp
qed

subsection {* Properties of the Conjugation Action *}

corollary stabilizer_supergrp_P:
  assumes fin:"finite (carrier G)"
  assumes P:"P \<in> subgroups_of_size p"
  shows "subgroup P (G\<lparr>carrier := group_action.stabilizer G (conjugation_action p) P\<rparr>)"
proof -
  from assms have "P \<subseteq> group_action.stabilizer G (conjugation_action p) P" by (rule stabilizer_contains_P)
  moreover from P have "subgroup P G" unfolding subgroups_of_size_def by simp
  moreover from P fin have "subgroup (group_action.stabilizer G (conjugation_action p) P) G" by (metis acts_on_subsets group_action.stabilizer_is_subgroup)
  ultimately show ?thesis by (metis is_group subgroup.subgroup_of_subset)
qed

lemma (in group) P_fixed_point_of_P_conj:
  assumes fin:"finite (carrier G)"
  assumes P:"P \<in> subgroups_of_size p"
  shows "P \<in> group_action.fixed_points (G\<lparr>carrier := P\<rparr>) (conjugation_action p) (subgroups_of_size p)"
proof -
  from fin interpret conjG: group_action G "conjugation_action p" "subgroups_of_size p" by (rule acts_on_subsets)
  from P have "subgroup P G" unfolding subgroups_of_size_def by simp
  with fin interpret conjP: group_action "G\<lparr>carrier := P\<rparr>" "(conjugation_action p)" "(subgroups_of_size p)" by (metis acts_on_subsets group_action.subgroup_action)
  from fin P have "P \<subseteq> conjG.stabilizer P" by (rule stabilizer_contains_P)
  hence "P \<subseteq> conjP.stabilizer P" using conjG.stabilizer_def conjP.stabilizer_def by auto
  with P show "P \<in> conjP.fixed_points" unfolding conjP.fixed_points_def by auto
qed

lemma conj_wo_inv:
  assumes QG:"subgroup Q G"
  assumes PG:"subgroup P G"
  assumes g:"g \<in> carrier G"
  assumes conj:"inv g <# (Q #> g) = P"
  shows "Q #> g = g <# P"
proof -
  from g have invg:"inv g \<in> carrier G" by (metis inv_closed)
  from conj have "g <# (inv g <# (Q #> g)) = g <# P" by simp
  with QG g invg have "(g \<otimes> inv g) <# (Q #> g) = g <# P" by (metis lcos_m_assoc r_coset_subset_G subgroup_imp_subset)
  with g invg have "\<one> <# (Q #> g) = g <# P" by (metis r_inv)
  with QG g show "Q #> g = g <# P" by (metis lcos_mult_one r_coset_subset_G subgroup_imp_subset)
qed

end

end


(*
    File:      Euler_Products.thy
    Author:    Manuel Eberl, TU München
*)
section \<open>Euler product expansions\<close>
theory Euler_Products
imports
  "HOL-Analysis.Analysis"
  Multiplicative_Function
begin

lemma prime_factors_power_subset:
  "prime_factors (x ^ n) \<subseteq> prime_factors x"
  by (cases "n = 0") (auto simp: prime_factors_power)

lemma prime_power_product_in_Pi:
  "(\<lambda>g. \<Prod>p\<in>{p. p \<le> (n::nat) \<and> prime p}. p ^ g p)
    \<in> ({p. p \<le> n \<and> prime p} \<rightarrow>\<^sub>E UNIV) \<rightarrow>
       {m. 0 < m \<and> prime_factors m \<subseteq> {..n}}"
proof (safe, goal_cases)
  case (2 f p)
  have "prime_factors (\<Prod>p\<in>{p. p \<le> n \<and> prime p}. p ^ f p) =
          (\<Union>p\<in>{p. p \<le> n \<and> prime p}. prime_factors (p ^ f p))"
    by (subst prime_factors_prod) auto
  also have "\<dots> \<subseteq> (\<Union>p\<in>{p. p \<le> n \<and> prime p}. prime_factors p)"
    using prime_factors_power_subset by blast
  also have "\<dots> \<subseteq> (\<Union>p\<in>{p. p \<le> n \<and> prime p}. {p})"
    by (auto simp: prime_factors_dvd prime_gt_0_nat dest!: dvd_imp_le)
  also have "\<dots> \<subseteq> {..n}" by auto
  finally show ?case using 2 by auto
qed (auto simp: prime_gt_0_nat)

lemma inj_prime_power: "inj_on (\<lambda>x. fst x ^ snd x :: nat) ({a. prime a} \<times> {0<..})"
proof (intro inj_onI, clarify, goal_cases)
  case (1 p m q n)
  with prime_power_eq_imp_eq[of p q m n] and 1
    have "p = q" by auto
  moreover from this have "m = n"
    using prime_gt_1_nat 1 by auto
  ultimately show ?case by simp
qed

lemma bij_betw_prime_powers:
  "bij_betw (\<lambda>g. \<Prod>p\<in>{p. p \<le> n \<and> prime p}. p ^ g p) ({p. p \<le> n \<and> prime p} \<rightarrow>\<^sub>E UNIV)
     {m. 0 < m \<and> prime_factors m \<subseteq> {..(n::nat)}}"
proof (rule bij_betwI[of _ _ _ "(\<lambda>m p. if p \<le> n \<and> prime p then multiplicity p m else undefined)"],
         goal_cases)
  case 1
  show ?case by (rule prime_power_product_in_Pi)
next
  case 2
  show ?case
    by (auto split: if_splits)
next
  case (3 f)
  show ?case
  proof (rule ext, goal_cases)
    case (1 q)
    show ?case
    proof (cases "q \<le> n \<and> prime q")
      case True
      hence "multiplicity q (\<Prod>p\<in>{p. p \<le> n \<and> prime p}. p ^ f p) =
               (\<Sum>x\<in>{p. p \<le> n \<and> prime p}. multiplicity q (x ^ f x))"
        by (subst prime_elem_multiplicity_prod_distrib) auto
      also have "\<dots> = (\<Sum>x\<in>{p. p \<le> n \<and> prime p}. if x = q then f q else 0)"
        using True by (intro sum.cong refl) (auto simp: multiplicity_distinct_prime_power)
      also have "\<dots> = f q" using True by auto
      finally show ?thesis using True by simp
    qed (insert 3, force+)
  qed
next
  case (4 m)
  have "(\<Prod>p | p \<le> n \<and> prime p. p ^ (if p \<le> n \<and> prime p then multiplicity p m else undefined)) =
          (\<Prod>p\<in>prime_factors m. p ^ multiplicity p m)"
  proof (rule prod.mono_neutral_cong)
    show "finite (prime_factors m)" by simp
  qed (insert 4, auto simp: prime_factors_multiplicity)
  also from 4 have "\<dots> = m"
    by (intro prime_factorization_nat [symmetric]) auto
  finally show ?case .
qed

lemma
  fixes f :: "nat \<Rightarrow> 'a :: {real_normed_field,banach,second_countable_topology}"
  assumes summable: "summable (\<lambda>n. norm (f n))"
  assumes "multiplicative_function f"
  shows   abs_convergent_euler_product:
            "abs_convergent_prod (\<lambda>p. if prime p then \<Sum>n. f (p ^ n) else 1)"
    and   euler_product_LIMSEQ:
            "(\<lambda>n. (\<Prod>p\<le>n. if prime p then \<Sum>n. f (p ^ n) else 1)) \<longlonglongrightarrow> (\<Sum>n. f n)"
proof -
  interpret f: multiplicative_function f by fact
  define N where "N = (\<Sum>n. norm (f n))"

  have summable': "f abs_summable_on A" for A
    by (rule abs_summable_on_subset[of _ UNIV])
       (insert summable, auto simp: abs_summable_on_nat_iff')

  have summable'': "(\<lambda>x. f (p ^ x)) abs_summable_on A" if "prime p" for A p
  proof (subst abs_summable_on_reindex_iff[of _ _ f])
    from \<open>prime p\<close> have "p > 1"
      by (rule prime_gt_1_nat)
    thus "inj_on (\<lambda>i. p ^ i) A"
      by (auto simp: inj_on_def)
  qed (intro summable')

  have "(\<lambda>n. norm ((\<Sum>m. f m) - (\<Prod>p\<in>{p. p \<le> n \<and> prime p}. \<Sum>i. f (p ^ i)))) \<longlonglongrightarrow> 0"
          (is "filterlim ?h _ _")
  proof (rule tendsto_sandwich)
    show "eventually (\<lambda>n. ?h n \<le> N - (\<Sum>m\<le>n. norm (f m))) at_top"
    proof (intro always_eventually allI)
      fix n :: nat
      interpret product_sigma_finite "\<lambda>_::nat. count_space (UNIV :: nat set)"
        by (intro product_sigma_finite.intro sigma_finite_measure_count_space)

      have "(\<Prod>p | p \<le> n \<and> prime p. \<Sum>i. f (p ^ i)) =
              (\<Prod>p | p \<le> n \<and> prime p. \<Sum>\<^sub>a i\<in>UNIV. f (p ^ i))"
        by (intro prod.cong refl infsetsum_nat' [symmetric] summable'') auto
      also have "\<dots> = (\<Sum>\<^sub>ag\<in>{p. p \<le> n \<and> prime p} \<rightarrow>\<^sub>E UNIV.
                         \<Prod>x\<in>{p. p \<le> n \<and> prime p}. f (x ^ g x))"
        by (subst infsetsum_prod_PiE [symmetric])
           (auto simp: prime_gt_Suc_0_nat summable'')
      also have "\<dots> = (\<Sum>\<^sub>ag\<in>{p. p \<le> n \<and> prime p} \<rightarrow>\<^sub>E UNIV.
                         f (\<Prod>x\<in>{p. p \<le> n \<and> prime p}. x ^ g x))"
        by (subst f.prod_coprime) (auto simp add: primes_coprime)
      also have "\<dots> = (\<Sum>\<^sub>am | m > 0 \<and> prime_factors m \<subseteq> {..n}. f m)"
        by (intro infsetsum_reindex_bij_betw bij_betw_prime_powers)
      also have "(\<Sum>\<^sub>am\<in>UNIV. f m) - \<dots> = (\<Sum>\<^sub>am\<in>UNIV - {m. m > 0 \<and> prime_factors m \<subseteq> {..n}}. f m)"
        by (intro infsetsum_Diff [symmetric] summable') auto
      also have "(\<Sum>\<^sub>am\<in>UNIV. f m) = (\<Sum>m. f m)"
        by (intro infsetsum_nat' summable')
      also have "UNIV - {m. m > 0 \<and> prime_factors m \<subseteq> {..n}} =
                   insert 0 {m. \<not>prime_factors m \<subseteq> {..n}}"
        by auto
      also have "(\<Sum>\<^sub>am\<in>\<dots>. f m) = (\<Sum>\<^sub>am | \<not>prime_factors m \<subseteq> {..n}. f m)"
        by (intro infsetsum_cong_neutral) auto
      also have "norm \<dots> \<le> (\<Sum>\<^sub>am | \<not>prime_factors m \<subseteq> {..n}. norm (f m))"
        by (rule norm_infsetsum_bound)
      also have "\<dots> \<le> (\<Sum>\<^sub>am\<in>{n<..}. norm (f m))"
      proof (intro infsetsum_mono_neutral_left summable' abs_summable_on_normI)
        show "{m. \<not> prime_factors m \<subseteq> {..n}} \<subseteq> {n<..}"
        proof safe
          fix m k assume "\<not>m > n" and "k \<in> prime_factors m"
          thus "k \<le> n" by (cases "m = 0") (auto simp: prime_factors_dvd dest: dvd_imp_le)
        qed
      qed auto
      also have "{n<..} = UNIV - {..n}"
        by auto
      also have "(\<Sum>\<^sub>am\<in>\<dots>. norm (f m)) = (\<Sum>\<^sub>am\<in>UNIV. norm (f m)) - (\<Sum>\<^sub>am\<in>{..n}. norm (f m))"
        using summable by (intro infsetsum_Diff) (auto simp: abs_summable_on_nat_iff')
      also have "(\<Sum>\<^sub>am\<in>UNIV. norm (f m)) = N"
        unfolding N_def using summable
        by (intro infsetsum_nat') (auto simp: abs_summable_on_nat_iff')
      also have "(\<Sum>\<^sub>am\<in>{..n}. norm (f m)) = (\<Sum>m\<le>n. norm (f m))"
        by (simp add: suminf_finite)
      finally show "?h n \<le> N - (\<Sum>m\<le>n. norm (f m))" .
   qed
  next
    show "eventually (\<lambda>n. ?h n \<ge> 0) at_top" by simp
  next
    show "(\<lambda>n. N - (\<Sum>m\<le>n. norm (f m))) \<longlonglongrightarrow> 0" unfolding N_def
      by (rule tendsto_eq_intros refl summable_LIMSEQ' summable)+ simp_all
  qed simp_all
  hence "(\<lambda>n. (\<Sum>m. f m) - (\<Prod>p\<in>{p. p \<le> n \<and> prime p}. \<Sum>i. f (p ^ i))) \<longlonglongrightarrow> 0"
    by (simp add: tendsto_norm_zero_iff)
  from tendsto_diff[OF tendsto_const[of "\<Sum>m. f m"] this]
    have "(\<lambda>n. \<Prod>p | p \<le> n \<and> prime p. \<Sum>i. f (p ^ i)) \<longlonglongrightarrow> (\<Sum>m. f m)" by simp
  also have "(\<lambda>n. \<Prod>p | p \<le> n \<and> prime p. \<Sum>i. f (p ^ i)) =
                 (\<lambda>n. \<Prod>p\<le>n. if prime p then (\<Sum>i. f (p ^ i)) else 1)"
    by (intro ext prod.mono_neutral_cong_left) auto
  finally show "\<dots> \<longlonglongrightarrow> (\<Sum>m. f m)" .

  show "abs_convergent_prod (\<lambda>p. if prime p then (\<Sum>i. f (p ^ i)) else 1)"
  proof (rule summable_imp_abs_convergent_prod)
    have "(\<lambda>(p,i). f (p ^ i)) abs_summable_on {p. prime p} \<times> {0<..}"
      unfolding case_prod_unfold
      by (subst abs_summable_on_reindex_iff[OF inj_prime_power]) fact
    hence "(\<lambda>p. \<Sum>\<^sub>ai\<in>{0<..}. f (p ^ i)) abs_summable_on {p. prime p}"
      by (rule abs_summable_on_Sigma_project1') simp_all
    also have "?this \<longleftrightarrow> (\<lambda>p. (\<Sum>i. f (p ^ i)) - 1) abs_summable_on {p. prime p}"
    proof (intro abs_summable_on_cong refl)
      fix p :: nat assume p: "p \<in> {p. prime p}"
      have "{0<..} = UNIV - {0::nat}" by auto
      also have "(\<Sum>\<^sub>ai\<in>\<dots>. f (p ^ i)) = (\<Sum>i. f (p ^ i)) - 1"
        using p by (subst infsetsum_Diff) (simp_all add: infsetsum_nat' summable'')
      finally show "(\<Sum>\<^sub>ai\<in>{0<..}. f (p ^ i)) = (\<Sum>i. f (p ^ i)) - 1" .
    qed
    finally have "summable (\<lambda>p. if prime p then norm ((\<Sum>i. f (p ^ i)) - 1) else 0)"
      (is "summable ?T") by (simp add: abs_summable_on_nat_iff)
    also have "?T = (\<lambda>p. norm ((if prime p then \<Sum>i. f (p ^ i) else 1) - 1))"
      by (rule ext) (simp add: if_splits)
    finally show "summable \<dots>" .
  qed
qed

lemma
  fixes f :: "nat \<Rightarrow> 'a :: {real_normed_field,banach,second_countable_topology}"
  assumes summable: "summable (\<lambda>n. norm (f n))"
  assumes "completely_multiplicative_function f"
  shows   abs_convergent_euler_product':
            "abs_convergent_prod (\<lambda>p. if prime p then inverse (1 - f p) else 1)"
    and   completely_multiplicative_summable_norm:
            "\<And>p. prime p \<Longrightarrow> norm (f p) < 1"
    and   euler_product_LIMSEQ':
            "(\<lambda>n. (\<Prod>p\<le>n. if prime p then inverse (1 - f p) else 1)) \<longlonglongrightarrow> (\<Sum>n. f n)"
proof -
  interpret f: completely_multiplicative_function f by fact
  {
    fix p :: nat assume "prime p"
    hence "inj (\<lambda>i. p ^ i)"
      by (auto simp: inj_on_def dest: prime_gt_1_nat)
    from summable_reindex[OF summable this]
      have *: "summable (\<lambda>i. norm (f (p ^ i)))" by (auto simp: o_def)
    also have "(\<lambda>i. norm (f (p ^ i))) = (\<lambda>i. norm (f p) ^ i)"
      by (simp add: f.power norm_power)
    finally show "norm (f p) < 1"
      by (subst (asm) summable_geometric_iff) simp_all
    note * and this
  } note summable' = this

  have eq: "(\<lambda>p. if prime p then (\<Sum>i. f (p ^ i)) else 1) =
              (\<lambda>p. if prime p then inverse (1 - f p) else 1)"
  proof (rule ext, goal_cases)
    case (1 p)
    show ?case
    proof (cases "prime p")
      case True
      hence "norm (f p) < 1" by (rule summable')
      from suminf_geometric[OF this] and True show ?thesis
        by (simp add: field_simps f.power)
    qed simp_all
  qed
  hence eq': "(\<lambda>n. \<Prod>p\<le>n. if prime p then \<Sum>n. f (p ^ n) else 1) =
                (\<lambda>n. \<Prod>p\<le>n. if prime p then inverse (1 - f p) else 1)"
    by (auto simp: fun_eq_iff)

  have f: "multiplicative_function f" ..
  from abs_convergent_euler_product[OF assms(1) f] and euler_product_LIMSEQ[OF assms(1) f]
    show "abs_convergent_prod (\<lambda>p. if prime p then inverse (1 - f p) else 1)"
       and "(\<lambda>n. \<Prod>p\<le>n. if prime p then inverse (1 - f p) else 1) \<longlonglongrightarrow> (\<Sum>n. f n)"
      by (simp_all only: eq eq')
qed

end