theory Multiplicative_Group
imports
  Complex_Main
  "~~/src/HOL/Algebra/Group"
  "~~/src/HOL/Number_Theory/MiscAlgebra"
  "~~/src/HOL/Algebra/Coset"
  "~~/src/HOL/Algebra/UnivPoly"
  "~~/src/HOL/Number_Theory/Number_Theory" (* XXX Only for the transfer to Z/pZ *)
begin

section {* Simplification Rules for Polynomials *}
text_raw {* \label{sec:simp-rules} *}

lemma (in ring_hom_cring) hom_sub[simp]:
  assumes "x \<in> carrier R" "y \<in> carrier R"
  shows "h (x \<ominus> y) = h x \<ominus>\<^bsub>S\<^esub> h y"
  using assms by (simp add: R.minus_eq S.minus_eq)

context UP_ring begin

lemma deg_nzero_nzero:
  assumes deg_p_nzero: "deg R p \<noteq> 0"
  shows "p \<noteq> \<zero>\<^bsub>P\<^esub>"
  using deg_zero deg_p_nzero by auto

lemma deg_add_eq:
  assumes c: "p \<in> carrier P" "q \<in> carrier P"
  assumes "deg R q \<noteq> deg R p"
  shows "deg R (p \<oplus>\<^bsub>P\<^esub> q) = max (deg R p) (deg R q)"
proof -
  let ?m = "max (deg R p) (deg R q)"
  from assms have "coeff P p ?m = \<zero> \<longleftrightarrow> coeff P q ?m \<noteq> \<zero>"
    by (metis deg_belowI lcoeff_nonzero[OF deg_nzero_nzero] linear min_max.le_iff_sup min_max.sup_absorb1)
  then have "coeff P (p \<oplus>\<^bsub>P\<^esub> q) ?m \<noteq> \<zero>"
    using assms by auto
  then have "deg R (p \<oplus>\<^bsub>P\<^esub> q) \<ge> ?m"
    using assms by (blast intro: deg_belowI)
  with deg_add[OF c] show ?thesis by arith
qed

lemma deg_minus_eq:
  assumes "p \<in> carrier P" "q \<in> carrier P" "deg R q \<noteq> deg R p"
  shows "deg R (p \<ominus>\<^bsub>P\<^esub> q) = max (deg R p) (deg R q)"
  using assms by (simp add: deg_add_eq a_minus_def)

end

context UP_cring begin

lemma evalRR_add:
  assumes "p \<in> carrier P" "q \<in> carrier P"
  assumes x:"x \<in> carrier R"
  shows "eval R R id x (p \<oplus>\<^bsub>P\<^esub> q) = eval R R id x p \<oplus> eval R R id x q"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  interpret ring_hom_cring P R "eval R R id x" by unfold_locales (rule eval_ring_hom[OF x])
  show ?thesis using assms by simp
qed

lemma evalRR_sub:
  assumes "p \<in> carrier P" "q \<in> carrier P"
  assumes x:"x \<in> carrier R"
  shows "eval R R id x (p \<ominus>\<^bsub>P\<^esub> q) = eval R R id x p \<ominus> eval R R id x q"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  interpret ring_hom_cring P R "eval R R id x" by unfold_locales (rule eval_ring_hom[OF x])
  show ?thesis using assms by simp
qed

lemma evalRR_mult:
  assumes "p \<in> carrier P" "q \<in> carrier P"
  assumes x:"x \<in> carrier R"
  shows "eval R R id x (p \<otimes>\<^bsub>P\<^esub> q) = eval R R id x p \<otimes> eval R R id x q"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  interpret ring_hom_cring P R "eval R R id x" by unfold_locales (rule eval_ring_hom[OF x])
  show ?thesis using assms by simp
qed

lemma evalRR_monom:
  assumes a: "a \<in> carrier R" and x: "x \<in> carrier R"
  shows "eval R R id x (monom P a d) = a \<otimes> x (^) d"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  show ?thesis using assms by (simp add: eval_monom)
qed

lemma evalRR_one:
  assumes x: "x \<in> carrier R"
  shows "eval R R id x \<one>\<^bsub>P\<^esub> = \<one>"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  interpret ring_hom_cring P R "eval R R id x" by unfold_locales (rule eval_ring_hom[OF x])
  show ?thesis using assms by simp
qed

lemma carrier_evalRR:
  assumes x: "x \<in> carrier R" and "p \<in> carrier P"
  shows "eval R R id x p \<in> carrier R"
proof -
  interpret UP_pre_univ_prop R R id by unfold_locales simp
  interpret ring_hom_cring P R "eval R R id x" by unfold_locales (rule eval_ring_hom[OF x])
  show ?thesis using assms by simp
qed

lemmas evalRR_simps = evalRR_add evalRR_sub evalRR_mult evalRR_monom evalRR_one carrier_evalRR

end

section {* Properties of the Euler @{text \<phi>}-function *}
text_raw {* \label{sec:euler-phi} *}

text{*
  In this section we prove that for every positive natural number the equation
  $\sum_{d | n}^n \varphi(d) = n$ holds.
*}

(* XXX Remove when we remove the Number_Theory import *)
hide_const (open) Multiset.mult
declare Cong.induct'_nat[induct del]

lemma dvd_div_ge_1 :
  fixes a b :: nat
  assumes "a \<ge> 1" "b dvd a"
  shows "a div b \<ge> 1"
  by (metis assms div_by_1 div_dvd_div div_less gcd_lcm_complete_lattice_nat.top_greatest
      gcd_lcm_complete_lattice_nat.top_le not_less)

lemma dvd_nat_bounds :
 fixes n p :: nat
 assumes "p > 0" "n dvd p"
 shows "n > 0 \<and> n \<le> p"
 using assms by (simp add: dvd_pos_nat dvd_imp_le)

(* Deviates from the definition given in the library in number theory *)
definition phi' :: "nat => nat"
  where "phi' m = card {x. 1 \<le> x \<and> x \<le> m \<and> gcd x m = 1}"

notation (latex_output)
  phi' ("\<phi> _")

lemma phi'_nonzero :
  assumes "m > 0"
  shows "phi' m > 0"
proof -
  have "1 \<in> {x. 1 \<le> x \<and> x \<le> m \<and> gcd x m = 1}" using assms by simp
  hence "card {x. 1 \<le> x \<and> x \<le> m \<and> gcd x m = 1} > 0" by (auto simp: card_gt_0_iff)
  thus ?thesis unfolding phi'_def by simp
qed

lemma dvd_div_eq_1:
  fixes a b c :: nat
  assumes "c dvd a" "c dvd b" "a div c = b div c"
  shows "a = b" using assms dvd_mult_div_cancel[OF `c dvd a`] dvd_mult_div_cancel[OF `c dvd b`]
                by presburger

lemma dvd_div_eq_2:
  fixes a b c :: nat
  assumes "c>0" "a dvd c" "b dvd c" "c div a = c div b"
  shows "a = b"
  proof -
  have "a > 0" "a \<le> c" using dvd_nat_bounds[OF assms(1-2)] by auto
  have "a*(c div a) = c" using assms dvd_mult_div_cancel by fastforce
  also have "\<dots> = b*(c div a)" using assms dvd_mult_div_cancel by fastforce
  finally show "a = b" using `c>0` dvd_div_ge_1[OF _ `a dvd c`] by fastforce
qed

lemma div_mult_mono:
  fixes a b c :: nat
  assumes "a > 0" "a\<le>d"
  shows "a * b div d \<le> b"
proof -
  have "a*b div d \<le> b*a div a" using assms div_le_mono2 nat_mult_commute[of a b] by presburger
  thus ?thesis using assms by force
qed

text{*
  We arrive at the main result of this section:
  For every positive natural number the equation $\sum_{d | n}^n \varphi(d) = n$ holds.

  The outline of the proof for this lemma is as follows:
  We count the $n$ fractions $1/n$, $\ldots$, $(n-1)/n$, $n/n$.
  We analyze the reduced form $a/d = m/n$ for any of those fractions.
  We want to know how many fractions $m/n$ have the reduced form denominator $d$.
  The condition $1 \leq m \leq n$ is equivalent to the condition $1 \leq a \leq d$.
  Therefore we want to know how many $a$ with $1 \leq a \leq d$ exist, s.t. @{term "gcd a d = 1"}.
  This number is exactly @{term "phi' d"}.

  Finally, by counting the fractions $m/n$ according to their reduced form denominator,
  we get: @{term [display] "(\<Sum>d | d dvd n . phi' d) = n"}.
  To formalize this proof in Isabelle, we analyze for an arbitrary divisor $d$ of $n$
  \begin{itemize}
    \item the set of reduced form numerators @{term "{a. (1::nat) \<le> a \<and> a \<le> d \<and> coprime a d}"}
    \item the set of numerators $m$, for which $m/n$ has the reduced form denominator $d$,
      i.e. the set @{term "{m \<in> {1::nat .. n}. n div gcd m n = d}"}
  \end{itemize}
  We show that @{term "\<lambda>a. a*n div d"} with the inverse @{term "\<lambda>a. a div gcd a n"} is
  a bijection between theses sets, thus yielding the equality
  @{term [display] "phi' d = card {m \<in> {1 .. n}. n div gcd m n = d}"}
  This gives us
  @{term [display] "(\<Sum>d | d dvd n . phi' d)
          = card (\<Union>d \<in> {d. d dvd n}. {m \<in> {1 .. n}. n div gcd m n = d})"}
  and by showing
  @{term "(\<Union>d \<in> {d. d dvd n}. {m \<in> {1::nat .. n}. n div gcd m n = d}) \<supseteq> {1 .. n}"}
  (this is our counting argument) the thesis follows.
*}
lemma sum_phi'_factors :
 fixes n :: nat
 assumes "n > 0"
 shows "(\<Sum>d | d dvd n. phi' d) = n"
proof -
  { fix d assume "d dvd n"
    have "card {a. 1 \<le> a \<and> a \<le> d \<and> coprime a d} = card {m \<in> {1 .. n}.  n div gcd m n = d}"
         (is "card ?RF = card ?F")
    proof (rule card_bij_eq)
      { fix a b assume "a * n div d = b * n div d"
        hence "a * (n div d) = b * (n div d)"
          using dvd_div_mult[OF `d dvd n`] by (fastforce simp add: nat_mult_commute)
        hence "a = b" using dvd_div_ge_1[OF _ `d dvd n`] `n>0`
          by (simp add: nat_mult_commute nat_mult_eq_cancel1)
      } thus "inj_on (\<lambda>a. a*n div d) ?RF" unfolding inj_on_def by blast
      { fix a assume a:"a\<in>?RF"
        hence "a * (n div d) \<ge> 1" using `n>0` dvd_div_ge_1[OF _ `d dvd n`] by simp
        hence ge_1:"a * n div d \<ge> 1" by (simp add: `d dvd n` div_mult_swap)
        have le_n:"a * n div d \<le> n" using div_mult_mono a by simp
        have "gcd (a * n div d) n = n div d * gcd a d"
          using dvd_div_mult_self[OF `d dvd n`]
          by (simp add: `d dvd n` div_mult_swap nat_mult_commute gcd_mult_distrib_nat)
        hence "n div gcd (a * n div d) n = d*n div (d*(n div d))" using a by simp
        hence "a * n div d \<in> ?F"
          using ge_1 le_n by (fastforce simp add: `d dvd n` dvd_mult_div_cancel)
      } thus "(\<lambda>a. a*n div d) ` ?RF \<subseteq> ?F" by blast
      { fix m l assume A: "m \<in> ?F" "l \<in> ?F" "m div gcd m n = l div gcd l n"
        hence "gcd m n = gcd l n" using dvd_div_eq_2[OF assms] by fastforce
        hence "m = l" using dvd_div_eq_1[of "gcd m n" m l] A(3) by fastforce
      } thus "inj_on (\<lambda>a. a div gcd a n) ?F" unfolding inj_on_def by blast
      { fix m assume "m \<in> ?F"
        hence "m div gcd m n \<in> ?RF" using dvd_div_ge_1
          by (fastforce simp add: div_le_mono div_gcd_coprime_nat)
      } thus "(\<lambda>a. a div gcd a n) ` ?F \<subseteq> ?RF" by blast
    qed force+
  } hence phi'_eq:"\<And>d. d dvd n \<Longrightarrow> phi' d = card {m \<in> {1 .. n}. n div gcd m n = d}"
      unfolding phi'_def by presburger
  have fin:"finite {d. d dvd n}" using dvd_nat_bounds[OF `n>0`] by force
  have "(\<Sum>d | d dvd n. phi' d)
                 = card (\<Union>d \<in> {d. d dvd n}. {m \<in> {1 .. n}. n div gcd m n = d})"
    using card_UN_disjoint[OF fin, of "(\<lambda>d. {m \<in> {1 .. n}. n div gcd m n = d})"] phi'_eq
    by fastforce
  also have "(\<Union>d \<in> {d. d dvd n}. {m \<in> {1 .. n}. n div gcd m n = d}) = {1 .. n}" (is "?L = ?R")
  proof
    show "?L \<supseteq> ?R"
    proof
      fix m assume m: "m \<in> ?R"
      thus "m \<in> ?L" using dvd_triv_right[of "n div gcd m n" "gcd m n"]
        by (simp add: dvd_mult_div_cancel)
    qed
  qed fastforce
  finally show ?thesis by force
qed

section {* Order of an Element of a Group *}
text_raw {* \label{sec:order-elem} *}

context group begin

lemma pow_eq_div2 :
  fixes m n :: nat
  assumes x_car: "x \<in> carrier G"
  assumes pow_eq: "x (^) m = x (^) n"
  shows "x (^) (m - n) = \<one>"
proof (cases "m < n")
  case False
  have "\<one> \<otimes> x (^) m = x (^) m" by (simp add: x_car)
  also have "\<dots> = x (^) (m - n) \<otimes> x (^) n"
    using False by (simp add: nat_pow_mult x_car)
  also have "\<dots> = x (^) (m - n) \<otimes> x (^) m"
    by (simp add: pow_eq)
  finally show ?thesis by (simp add: x_car)
qed simp

definition ord where "ord a = Min {d \<in> {1 .. order G} . a (^) d = \<one>}"

lemma
  assumes finite:"finite (carrier G)"
  assumes a:"a \<in> carrier G"
  shows ord_ge_1: "1 \<le> ord a" and ord_le_group_order: "ord a \<le> order G"
    and pow_ord_eq_1: "a (^) ord a = \<one>"
proof -
  have "\<not>inj_on (\<lambda>x. a (^) x) {0 .. order G}"
  proof (rule notI)
    assume A: "inj_on (\<lambda>x. a (^) x) {0 .. order G}"
    have "order G + 1 = card {0 .. order G}" by simp
    also have "\<dots> = card ((\<lambda>x. a (^) x) ` {0 .. order G})" (is "_ = card ?S")
      using A by (simp add: card_image)
    also have "?S = {a (^) x | x. x \<in> {0 .. order G}}" by blast
    also have "\<dots> \<subseteq> carrier G" (is "?S \<subseteq> _") using a by blast
    then have "card ?S \<le> order G" unfolding order_def
      by (rule card_mono[OF finite])
    finally show False by arith
  qed

  then obtain x y where x_y:"x \<noteq> y" "x \<in> {0 .. order G}" "y \<in> {0 .. order G}"
                        "a (^) x = a (^) y" unfolding inj_on_def by blast
  obtain d where "1 \<le> d" "a (^) d = \<one>" "d \<le> order G"
  proof cases
    assume "y < x" with x_y show ?thesis
      by (intro that[where d="x - y"]) (auto simp add: pow_eq_div2[OF a])
  next
    assume "\<not>y < x" with x_y show ?thesis
      by (intro that[where d="y - x"]) (auto simp add: pow_eq_div2[OF a])
  qed
  hence "ord a \<in> {d \<in> {1 .. order G} . a (^) d = \<one>}"
    unfolding ord_def using Min_in[of "{d \<in> {1 .. order G} . a (^) d = \<one>}"]
    by fastforce
  then show "1 \<le> ord a" and "ord a \<le> order G" and "a (^) ord a = \<one>"
    by (auto simp: order_def)
qed

lemma finite_group_elem_finite_ord :
  assumes "finite (carrier G)" "x \<in> carrier G"
  shows "\<exists> d::nat. d \<ge> 1 \<and> x (^) d = \<one>"
  using assms ord_ge_1 pow_ord_eq_1 by auto

lemma ord_min:
  assumes  "finite (carrier G)" "1 \<le> d" "a \<in> carrier G" "a (^) d = \<one>" shows "ord a \<le> d"
proof -
  def Ord \<equiv> "{d \<in> {1..order G}. a (^) d = \<one>}"
  have fin: "finite Ord" by (auto simp: Ord_def)
  have in_ord: "ord a \<in> Ord"
    using assms pow_ord_eq_1 ord_ge_1 ord_le_group_order by (auto simp: Ord_def)
  then have "Ord \<noteq> {}" by auto

  show ?thesis
  proof (cases "d \<le> order G")
    case True
    then have "d \<in> Ord" using assms by (auto simp: Ord_def)
    with fin in_ord show ?thesis
      unfolding ord_def Ord_def[symmetric] by simp
  next
    case False
    then show ?thesis using in_ord by (simp add: Ord_def)
  qed
qed

lemma ord_inj :
  assumes finite: "finite (carrier G)"
  assumes a: "a \<in> carrier G"
  shows "inj_on (\<lambda> x . a (^) x) {0 .. ord a - 1}"
proof (rule inj_onI, rule ccontr)
  fix x y assume A: "x \<in> {0 .. ord a - 1}" "y \<in> {0 .. ord a - 1}" "a (^) x= a (^) y" "x \<noteq> y"

  have "finite {d \<in> {1..order G}. a (^) d = \<one>}" by auto

  { fix x y assume A: "x < y" "x \<in> {0 .. ord a - 1}" "y \<in> {0 .. ord a - 1}"
        "a (^) x = a (^) y"
    hence "y - x < ord a" by auto
    also have "\<dots> \<le> order G" using assms by (simp add: ord_le_group_order)
    finally have y_x_range:"y - x \<in> {1 .. order G}" using A by force
    have "a (^) (y-x) = \<one>" using a A by (simp add: pow_eq_div2)

    hence y_x:"y - x \<in> {d \<in> {1.. order G}. a (^) d = \<one>}" using y_x_range by blast
    have "min (y - x) (ord a) = ord a"
      using Min.in_idem[OF `finite {d \<in> {1 .. order G} . a (^) d = \<one>}` y_x] ord_def by auto
    with `y - x < ord a` have False by linarith
  }
  note X = this

  { assume "x < y" with A X have False by blast }
  moreover
  { assume "x > y" with A X  have False by metis }
  moreover
  { assume "x = y" then have False using A by auto}
  ultimately
  show False by fastforce
qed

lemma ord_inj' :
  assumes finite: "finite (carrier G)"
  assumes a: "a \<in> carrier G"
  shows "inj_on (\<lambda> x . a (^) x) {1 .. ord a}"
proof (rule inj_onI, rule ccontr)
  fix x y :: nat
  assume A:"x \<in> {1 .. ord a}" "y \<in> {1 .. ord a}" "a (^) x = a (^) y" "x\<noteq>y"
  { assume "x < ord a" "y < ord a"
    hence False using ord_inj[OF assms] A unfolding inj_on_def by fastforce
  }
  moreover
  { assume "x = ord a" "y < ord a"
    hence "a (^) y = a (^) (0::nat)" using pow_ord_eq_1[OF assms] A by auto
    hence "y=0" using ord_inj[OF assms] `y < ord a` unfolding inj_on_def by force
    hence False using A by fastforce
  }
  moreover
  { assume "y = ord a" "x < ord a"
    hence "a (^) x = a (^) (0::nat)" using pow_ord_eq_1[OF assms] A by auto
    hence "x=0" using ord_inj[OF assms] `x < ord a` unfolding inj_on_def by force
    hence False using A by fastforce
  }
  ultimately show False using A  by force
qed

lemma ord_elems :
  assumes "finite (carrier G)" "a \<in> carrier G"
  shows "{a(^)x | x. x \<in> (UNIV :: nat set)} = {a(^)x | x. x \<in> {0 .. ord a - 1}}" (is "?L = ?R")
proof
  show "?R \<subseteq> ?L" by blast
  { fix y assume "y \<in> ?L"
    then obtain x::nat where x:"y = a(^)x" by auto
    def r \<equiv> "x mod ord a"
    then obtain q where q:"x = q * ord a + r" using mod_eqD by atomize_elim presburger
    hence "y = (a(^)ord a)(^)q \<otimes> a(^)r"
      using x assms by (simp add: nat_mult_commute nat_pow_mult nat_pow_pow)
    hence "y = a(^)r" using assms by (simp add: pow_ord_eq_1)
    have "r < ord a" using ord_ge_1[OF assms] by (simp add: r_def)
    hence "r \<in> {0 .. ord a - 1}" by (force simp: r_def)
    hence "y \<in> {a(^)x | x. x \<in> {0 .. ord a - 1}}" using `y=a(^)r` by blast
  }
  thus "?L \<subseteq> ?R" by auto
qed

lemma ord_dvd_pow_eq_1 :
  assumes "finite (carrier G)" "a \<in> carrier G" "a (^) k = \<one>"
  shows "ord a dvd k"
proof -
  def r \<equiv> "k mod ord a"
  then obtain q where q:"k = q*ord a + r" using mod_eqD by atomize_elim presburger
  hence "a(^)k = (a(^)ord a)(^)q \<otimes> a(^)r"
      using assms by (simp add: nat_mult_commute nat_pow_mult nat_pow_pow)
  hence "a(^)k = a(^)r" using assms by (simp add: pow_ord_eq_1)
  hence "a(^)r = \<one>" using assms(3) by simp
  have "r < ord a" using ord_ge_1[OF assms(1-2)] by (simp add: r_def)
  hence "r = 0" using `a(^)r = \<one>` ord_def[of a] ord_min[of r a] assms(1-2) by linarith
  thus ?thesis using q by simp
qed

lemma dvd_gcd :
  fixes a b :: nat
  obtains q where "a * (b div gcd a b) = b*q"
proof
  have "a * (b div gcd a b) = (a div gcd a b) * b" by (simp add:  div_mult_swap dvd_div_mult)
  also have "\<dots> = b * (a div gcd a b)" by simp
  finally show "a * (b div gcd a b) = b * (a div gcd a b) " .
qed

lemma ord_pow_dvd_ord_elem :
  assumes finite[simp]: "finite (carrier G)"
  assumes a[simp]:"a \<in> carrier G"
  shows "ord (a(^)n) = ord a div gcd n (ord a)"
proof -
  have "(a(^)n) (^) ord a = (a (^) ord a) (^) n"
    by (simp add: nat_mult_commute nat_pow_pow)
  hence "(a(^)n) (^) ord a = \<one>" by (simp add: pow_ord_eq_1)
  obtain q where "n * (ord a div gcd n (ord a)) = ord a * q" by (rule dvd_gcd)
  hence "(a(^)n) (^) (ord a div gcd n (ord a)) = (a (^) ord a)(^)q"  by (simp add : nat_pow_pow)
  hence pow_eq_1: "(a(^)n) (^) (ord a div gcd n (ord a)) = \<one>"
     by (auto simp add : pow_ord_eq_1[of a])
  have "ord a \<ge> 1" using ord_ge_1 by simp
  have ge_1:"ord a div gcd n (ord a) \<ge> 1"
  proof -
    have "gcd n (ord a) dvd ord a" by blast
    thus ?thesis by (rule dvd_div_ge_1[OF `ord a \<ge> 1`])
  qed
  have "ord a \<le> order G" by (simp add: ord_le_group_order)
  have "ord a div gcd n (ord a) \<le> order G"
  proof -
    have "ord a div gcd n (ord a) \<le> ord a" by simp
    thus ?thesis using `ord a \<le> order G` by linarith
  qed
  hence ord_gcd_elem:"ord a div gcd n (ord a) \<in> {d \<in> {1..order G}. (a(^)n) (^) d = \<one>}"
    using ge_1 pow_eq_1 by force
  { fix d :: nat
    assume d_elem:"d \<in> {d \<in> {1..order G}. (a(^)n) (^) d = \<one>}"
    assume d_lt:"d < ord a div gcd n (ord a)"
    hence pow_nd:"a(^)(n*d)  = \<one>" using d_elem
      by (simp add : nat_pow_pow)
    hence "ord a dvd n*d" using assms by (auto simp add : ord_dvd_pow_eq_1)
    then obtain q where "ord a * q = n*d" by (metis dvd_mult_div_cancel)
    hence prod_eq:"(ord a div gcd n (ord a)) * q = (n div gcd n (ord a)) * d"
      by (simp add: dvd_div_mult)
    have cp:"coprime (ord a div gcd n (ord a)) (n div gcd n (ord a))"
    proof -
      have "coprime (n div gcd n (ord a)) (ord a div gcd n (ord a))"
        using div_gcd_coprime_nat[of n "ord a"] ge_1 by fastforce
      thus ?thesis by (simp add: gcd_commute_nat)
    qed
    have dvd_d:"(ord a div gcd n (ord a)) dvd d"
    proof -
      have "ord a div gcd n (ord a) dvd (n div gcd n (ord a)) * d" using prod_eq
        by (metis dvd_triv_right nat_mult_commute)
      hence "ord a div gcd n (ord a) dvd d * (n div gcd n (ord a))"
        by (simp add:  nat_mult_commute)
      thus ?thesis using coprime_dvd_mult_nat[OF cp, of d] by fastforce
    qed
    have "d > 0" using d_elem by simp
    hence "ord a div gcd n (ord a) \<le> d" using dvd_d by (simp add : Nat.dvd_imp_le)
    hence False using d_lt by simp
  } hence ord_gcd_min: "\<And> d . d \<in> {d \<in> {1..order G}. (a(^)n) (^) d = \<one>}
                        \<Longrightarrow> d\<ge>ord a div gcd n (ord a)" by fastforce
  have fin:"finite {d \<in> {1..order G}. (a(^)n) (^) d = \<one>}" by auto
  thus ?thesis using Min_eqI[OF fin ord_gcd_min ord_gcd_elem]
    unfolding ord_def by simp
qed

lemma ord_1_eq_1 :
  assumes "finite (carrier G)"
  shows "ord \<one> = 1"
 using assms ord_ge_1 ord_min[of 1 \<one>] by force

theorem lagrange_dvd:
 assumes "finite(carrier G)" "subgroup H G" shows "(card H) dvd (order G)"
 using assms by (simp add: lagrange[symmetric])

lemma element_generates_subgroup:
  assumes finite[simp]: "finite (carrier G)"
  assumes a[simp]: "a \<in> carrier G"
  shows "subgroup {a (^) i | i. i \<in> {0 .. ord a - 1}} G"
proof
  show "{a(^)i | i. i \<in> {0 .. ord a - 1} } \<subseteq> carrier G" by auto
next
  fix x y
  assume A: "x \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}" "y \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}"
  obtain i::nat where i:"x = a(^)i" and i2:"i \<in> UNIV" using A by auto
  obtain j::nat where j:"y = a(^)j" and j2:"j \<in> UNIV" using A by auto
  have "a(^)(i+j) \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}" using ord_elems[OF assms] A by auto
  thus "x \<otimes> y \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}"
    using i j a ord_elems assms by (auto simp add: nat_pow_mult)
next
  show "\<one> \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}" by force
next
  fix x assume x: "x \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}"
  hence x_in_carrier: "x \<in> carrier G" by auto
  then obtain d::nat where d:"x (^) d = \<one>" and "d\<ge>1"
    using finite_group_elem_finite_ord by auto
  have inv_1:"x(^)(d - 1) \<otimes> x = \<one>" using `d\<ge>1` d nat_pow_Suc[of x "d - 1"] by simp
  have elem:"x (^) (d - 1) \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}"
  proof -
    obtain i::nat where i:"x = a(^)i" using x by auto
    hence "x(^)(d - 1) \<in> {a(^)i | i. i \<in> (UNIV::nat set)}" by (auto simp add: nat_pow_pow)
    thus ?thesis using ord_elems[of a] by auto
  qed
  have inv:"inv x = x(^)(d - 1)" using inv_equality[OF inv_1] x_in_carrier by blast
  thus "inv x \<in> {a(^)i | i. i \<in> {0 .. ord a - 1}}" using elem inv by auto
qed

lemma ord_dvd_group_order :
  assumes finite[simp]: "finite (carrier G)"
  assumes a[simp]: "a \<in> carrier G"
  shows "ord a dvd order G"
proof -
  have card_dvd:"card {a(^)i | i. i \<in> {0 .. ord a - 1}} dvd card (carrier G)"
    using lagrange_dvd element_generates_subgroup unfolding order_def by simp
  have "inj_on (\<lambda> i . a(^)i) {0..ord a - 1}" using ord_inj by simp
  hence cards_eq:"card ( (\<lambda> i . a(^)i) ` {0..ord a - 1}) = card {0..ord a - 1}"
    using card_image[of "\<lambda> i . a(^)i" "{0..ord a - 1}"] by auto
  have "(\<lambda> i . a(^)i) ` {0..ord a - 1} = {a(^)i | i. i \<in> {0..ord a - 1}}" by auto
  hence "card {a(^)i | i. i \<in> {0..ord a - 1}} = card {0..ord a - 1}" using cards_eq by simp
  also have "\<dots> = ord a" using ord_ge_1[of a] by simp
  finally show ?thesis using card_dvd by (simp add: order_def)
qed

end

section {* Number of Roots of a Polynomial *}
text_raw {* \label{sec:number-roots} *}

definition mult_of :: "('a, 'b) ring_scheme \<Rightarrow> 'a monoid" where
  "mult_of R \<equiv> \<lparr> carrier = carrier R - {\<zero>\<^bsub>R\<^esub>}, mult = mult R, one = \<one>\<^bsub>R\<^esub>\<rparr>"

lemma carrier_mult_of: "carrier (mult_of R) = carrier R - {\<zero>\<^bsub>R\<^esub>}"
  by (simp add: mult_of_def)

lemma mult_mult_of: "mult (mult_of R) = mult R"
 by (simp add: mult_of_def)

lemma nat_pow_mult_of: "op (^)\<^bsub>mult_of R\<^esub> = (op (^)\<^bsub>R\<^esub> :: _ \<Rightarrow> nat \<Rightarrow> _)"
  by (simp add: mult_of_def fun_eq_iff nat_pow_def)

lemma one_mult_of: "\<one>\<^bsub>mult_of R\<^esub> = \<one>\<^bsub>R\<^esub>"
  by (simp add: mult_of_def)

lemmas mult_of_simps = carrier_mult_of mult_mult_of nat_pow_mult_of one_mult_of

context field begin

lemma field_mult_group :
  shows "group (mult_of R)"
  apply (rule groupI)
  apply (auto simp: mult_of_simps m_assoc dest: integral)
  by (metis Diff_iff Units_inv_Units Units_l_inv field_Units singletonE)

lemma finite_mult_of: "finite (carrier R) \<Longrightarrow> finite (carrier (mult_of R))"
  by (auto simp: mult_of_simps)

lemma order_mult_of: "finite (carrier R) \<Longrightarrow> order (mult_of R) = order R - 1"
  unfolding order_def carrier_mult_of by (simp add: card.remove)

end

lemma (in monoid) Units_pow_closed :
  fixes d :: nat
  assumes "x \<in> Units G"
  shows "x (^) d \<in> Units G"
    by (metis assms group.is_monoid monoid.nat_pow_closed units_group units_of_carrier units_of_pow)

lemma (in comm_monoid) is_monoid:
  shows "monoid G" by unfold_locales

declare comm_monoid.is_monoid[intro?]

lemma (in ring) r_right_minus_eq[simp]:
  assumes "a \<in> carrier R" "b \<in> carrier R"
  shows "a \<ominus> b = \<zero> \<longleftrightarrow> a = b"
  using assms by (metis a_minus_def add.inv_closed minus_equality r_neg)

context UP_cring begin

lemma is_UP_cring:"UP_cring R" by (unfold_locales)
lemma is_UP_ring :
  shows "UP_ring R" by (unfold_locales)

end

context UP_domain begin

lemma roots_bound:
  assumes f [simp]: "f \<in> carrier P"
  assumes f_not_zero: "f \<noteq> \<zero>\<^bsub>P\<^esub>"
  assumes finite: "finite (carrier R)"
  shows "finite {a \<in> carrier R . eval R R id a f = \<zero>} \<and>
         card {a \<in> carrier R . eval R R id a f = \<zero>} \<le> deg R f" using f f_not_zero
proof (induction "deg R f" arbitrary: f)
  case 0
  have "\<And>x. eval R R id x f \<noteq> \<zero>"
  proof -
    fix x
    have "(\<Oplus>i\<in>{..deg R f}. id (coeff P f i) \<otimes> x (^) i) \<noteq> \<zero>"
      using 0 lcoeff_nonzero_nonzero[where p = f] by simp
    thus "eval R R id x f \<noteq> \<zero>" using 0 unfolding eval_def P_def by simp
  qed
  then have *: "{a \<in> carrier R. eval R R (\<lambda>a. a) a f = \<zero>} = {}"
    by (auto simp: id_def)
  show ?case by (simp add: *)
next
  case (Suc x)
  show ?case
  proof (cases "\<exists> a \<in> carrier R . eval R R id a f = \<zero>")
    case True
    then obtain a where a_carrier[simp]: "a \<in> carrier R" and a_root:"eval R R id a f = \<zero>" by blast
    have R_not_triv: "carrier R \<noteq> {\<zero>}"
      by (metis R.one_zeroI R.zero_not_one)
    obtain q  where q:"(q \<in> carrier P)" and
      f:"f = (monom P \<one>\<^bsub>R\<^esub> 1 \<ominus>\<^bsub> P\<^esub> monom P a 0) \<otimes>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> monom P (eval R R id a f) 0"
     using remainder_theorem[OF Suc.prems(1) a_carrier R_not_triv] by auto
    hence lin_fac: "f = (monom P \<one>\<^bsub>R\<^esub> 1 \<ominus>\<^bsub> P\<^esub> monom P a 0) \<otimes>\<^bsub>P\<^esub> q" using q by (simp add: a_root)
    have deg:"deg R (monom P \<one>\<^bsub>R\<^esub> 1 \<ominus>\<^bsub> P\<^esub> monom P a 0) = 1"
      using a_carrier by (simp add: deg_minus_eq)
    hence mon_not_zero:"(monom P \<one>\<^bsub>R\<^esub> 1 \<ominus>\<^bsub> P\<^esub> monom P a 0) \<noteq> \<zero>\<^bsub>P\<^esub>"
      by (fastforce simp del: r_right_minus_eq)
    have q_not_zero:"q \<noteq> \<zero>\<^bsub>P\<^esub>" using Suc by (auto simp add : lin_fac)
    hence "deg R q = x" using Suc deg deg_mult[OF mon_not_zero q_not_zero _ q]
      by (simp add : lin_fac)
    hence q_IH:"finite {a \<in> carrier R . eval R R id a q = \<zero>}
                \<and> card {a \<in> carrier R . eval R R id a q = \<zero>} \<le> x" using Suc q q_not_zero by blast
    have subs:"{a \<in> carrier R . eval R R id a f = \<zero>}
                \<subseteq> {a \<in> carrier R . eval R R id a q = \<zero>} \<union> {a}" (is "?L \<subseteq> ?R \<union> {a}")
      using a_carrier `q \<in> _`
      by (auto simp: evalRR_simps lin_fac R.integral_iff)
    have "{a \<in> carrier R . eval R R id a f = \<zero>} \<subseteq> insert a {a \<in> carrier R . eval R R id a q = \<zero>}"
     using subs by auto
    hence "card {a \<in> carrier R . eval R R id a f = \<zero>} \<le>
           card (insert a {a \<in> carrier R . eval R R id a q = \<zero>})" using q_IH by (blast intro: card_mono)
    also have "\<dots> \<le> deg R f" using q_IH `Suc x = _`
      by (simp add: card_insert_if)
    finally show ?thesis using q_IH `Suc x = _` using finite by force
  next
    case False
    hence "card {a \<in> carrier R. eval R R id a f = \<zero>} = 0" using finite by auto
    also have "\<dots> \<le>  deg R f" by simp
    finally show ?thesis using finite by auto
  qed
qed

end

lemma (in domain) num_roots_le_deg :
  fixes p d :: nat
  assumes finite:"finite (carrier R)"
  assumes d_neq_zero : "d \<noteq> 0"
  shows "card {x \<in> carrier R. x (^) d = \<one>} \<le> d"
proof -
  let ?f = "monom (UP R) \<one>\<^bsub>R\<^esub> d \<ominus>\<^bsub> (UP R)\<^esub> monom (UP R) \<one>\<^bsub>R\<^esub> 0"
  have one_in_carrier:"\<one> \<in> carrier R" by simp
  interpret R: UP_domain R "UP R" by (unfold_locales)
  have "deg R ?f = d"
    using d_neq_zero by (simp add: R.deg_minus_eq)
  hence f_not_zero:"?f \<noteq> \<zero>\<^bsub>UP R\<^esub>" using  d_neq_zero by (auto simp add : R.deg_nzero_nzero)
  have roots_bound:"finite {a \<in> carrier R . eval R R id a ?f = \<zero>} \<and>
                    card {a \<in> carrier R . eval R R id a ?f = \<zero>} \<le> deg R ?f"
                    using finite by (intro R.roots_bound[OF _ f_not_zero]) simp
  have subs:"{x \<in> carrier R. x (^) d = \<one>} \<subseteq> {a \<in> carrier R . eval R R id a ?f = \<zero>}"
    by (auto simp: R.evalRR_simps)
  then have "card {x \<in> carrier R. x (^) d = \<one>} \<le>
        card {a \<in> carrier R. eval R R id a ?f = \<zero>}" using finite by (simp add : card_mono)
  thus ?thesis using `deg R ?f = d` roots_bound by linarith
qed

section {* The Multiplicative Group of a Field *}
text_raw {* \label{sec:mult-group} *}

text {*
  In this section we show that the multiplicative group of a finite field
  is generated by a single element, i.e. it is cyclic. The proof is inspired
  by the first proof given in the survey~\cite{conrad-cyclicity}.
*}

lemma (in group) pow_order_eq_1:
  assumes "finite (carrier G)" "x \<in> carrier G" shows "x (^) order G = \<one>"
  using assms by (metis nat_pow_pow ord_dvd_group_order pow_ord_eq_1 dvdE nat_pow_one)

(* XXX remove in AFP devel, replaced by div_eq_dividend_iff *)
lemma nat_div_eq: "a \<noteq> 0 \<Longrightarrow> (a :: nat) div b = a \<longleftrightarrow> b = 1"
  apply rule
  apply (cases "b = 0")
  apply simp_all
  apply (metis (full_types) One_nat_def Suc_lessI div_less_dividend less_not_refl3)
  done

lemma (in group)
  assumes finite': "finite (carrier G)"
  assumes "a \<in> carrier G"
  shows pow_ord_eq_ord_iff: "group.ord G (a (^) k) = ord a \<longleftrightarrow> coprime k (ord a)" (is "?L \<longleftrightarrow> ?R")
proof
  assume A: ?L then show ?R
    using assms ord_ge_1[OF assms] by (auto simp: nat_div_eq ord_pow_dvd_ord_elem)
next
  assume ?R then show ?L
    using ord_pow_dvd_ord_elem[OF assms, of k] by auto
qed

context field begin

lemma num_elems_of_ord_eq_phi':
  assumes finite: "finite (carrier R)" and dvd: "d dvd order (mult_of R)"
      and exists: "\<exists>a\<in>carrier (mult_of R). group.ord (mult_of R) a = d"
  shows "card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = d} = phi' d"
proof -
  note mult_of_simps[simp]
  have finite': "finite (carrier (mult_of R))" using finite by (rule finite_mult_of)

  interpret G:group "mult_of R" where "op (^)\<^bsub>mult_of R\<^esub> = (op (^) :: _ \<Rightarrow> nat \<Rightarrow> _)" and "\<one>\<^bsub>mult_of R\<^esub> = \<one>"
    by (rule field_mult_group) simp_all

  from exists
  obtain a where a:"a \<in> carrier (mult_of R)" and ord_a: "group.ord (mult_of R) a = d"
    by (auto simp add: card_gt_0_iff)

  have set_eq1:"{a(^)n| n. n \<in> {1 .. d}} = {x \<in> carrier (mult_of R). x (^) d = \<one>}"
  proof (rule card_seteq)
    show "finite {x \<in> carrier (mult_of R). x (^) d = \<one>}" using finite by auto

    show "{a(^)n| n. n \<in> {1 ..d}} \<subseteq> {x \<in> carrier (mult_of R). x(^)d = \<one>}"
    proof
      fix x assume "x \<in> {a(^)n | n. n \<in> {1 .. d}}"
      then obtain n where n:"x = a(^)n \<and> n \<in> {1 .. d}" by auto
      have "x(^)d =(a(^)d)(^)n" using n a ord_a by (simp add:nat_pow_pow nat_mult_commute)
      hence "x(^)d = \<one>" using ord_a G.pow_ord_eq_1[OF finite' a] by fastforce
      thus "x \<in> {x \<in> carrier (mult_of R). x(^)d = \<one>}" using G.nat_pow_closed[OF a] n by blast
    qed

    show "card {x \<in> carrier (mult_of R). x (^) d = \<one>} \<le> card {a(^)n | n. n \<in> {1 .. d}}"
    proof -
      have *:"{a(^)n | n. n \<in> {1 .. d }} = ((\<lambda> n. a(^)n) ` {1 .. d})" by auto
      have "0 < order (mult_of R)" unfolding order_mult_of[OF finite]
        using card_mono[OF finite, of "{\<zero>, \<one>}"] by (simp add: order_def)
      have "card {x \<in> carrier (mult_of R). x (^) d = \<one>} \<le> card {x \<in> carrier R. x (^) d = \<one>}"
        using finite by (auto intro: card_mono)
      also have "\<dots> \<le> d" using `0 < order (mult_of R)` num_roots_le_deg[OF finite, of d]
        by (simp add : dvd_pos_nat[OF _ `d dvd order (mult_of R)`])
      finally show ?thesis using G.ord_inj'[OF finite' a] ord_a * by (simp add: card_image)
    qed
  qed

  have set_eq2:"{x \<in> carrier (mult_of R) . group.ord (mult_of R) x = d}
                = (\<lambda> n . a(^)n) ` {n \<in> {1 .. d}. group.ord (mult_of R) (a(^)n) = d}" (is "?L = ?R")
  proof
    { fix x assume x:"x \<in> (carrier (mult_of R)) \<and> group.ord (mult_of R) x = d"
      hence "x \<in> {x \<in> carrier (mult_of R). x (^) d = \<one>}"
        by (simp add: G.pow_ord_eq_1[OF finite', of x, symmetric])
      then obtain n where n:"x = a(^)n \<and> n \<in> {1 .. d}" using set_eq1 by blast
      hence "x \<in> ?R" using x by fast
    } thus "?L \<subseteq> ?R" by blast
    show "?R \<subseteq> ?L" using a by (auto simp add: carrier_mult_of[symmetric] simp del: carrier_mult_of)
  qed
  have "inj_on (\<lambda> n . a(^)n) {n \<in> {1 .. d}. group.ord (mult_of R) (a(^)n) = d}"
    using G.ord_inj'[OF finite' a, unfolded ord_a] unfolding inj_on_def by fast
  hence "card ((\<lambda>n. a(^)n) ` {n \<in> {1 .. d}. group.ord (mult_of R) (a(^)n) = d})
         = card {k \<in> {1 .. d}. group.ord (mult_of R) (a(^)k) = d}"
         using card_image by blast
  thus ?thesis using set_eq2 G.pow_ord_eq_ord_iff[OF finite' `a \<in> _`, unfolded ord_a]
    by (simp add: phi'_def)
qed

end

theorem (in field) finite_field_mult_group_has_gen :
  assumes finite:"finite (carrier R)"
  shows "\<exists> a \<in> carrier (mult_of R) . carrier (mult_of R) = {a(^)i | i::nat . i \<in> UNIV}"
proof -
  note mult_of_simps[simp]
  have finite': "finite (carrier (mult_of R))" using finite by (rule finite_mult_of)

  interpret G: group "mult_of R" where
      "op (^)\<^bsub>mult_of R\<^esub> = (op (^) :: _ \<Rightarrow> nat \<Rightarrow> _)" and "\<one>\<^bsub>mult_of R\<^esub> = \<one>"
    by (rule field_mult_group) (simp_all add: fun_eq_iff nat_pow_def)

  let ?N = "\<lambda> x . card {a \<in> carrier (mult_of R). group.ord (mult_of R) a  = x}"
  have "0 < order R - 1" unfolding order_def using card_mono[OF finite, of "{\<zero>, \<one>}"] by simp
  then have *: "0 < order (mult_of R)" using assms by (simp add: order_mult_of)
  have fin: "finite {d. d dvd order (mult_of R) }" using dvd_nat_bounds[OF *] by force

  have "(\<Sum>d | d dvd order (mult_of R). ?N d)
      = card (UN d:{d . d dvd order (mult_of R) }. {a \<in> carrier (mult_of R). group.ord (mult_of R) a  = d})"
      (is "_ = card ?U")
    using fin finite by (subst card_UN_disjoint) auto
  also have "?U = carrier (mult_of R)"
  proof
    { fix x assume x:"x \<in> carrier (mult_of R)"
      hence x':"x\<in>carrier (mult_of R)" by simp
      then have "group.ord (mult_of R) x dvd order (mult_of R)"
          using finite' G.ord_dvd_group_order[OF _ x'] by (simp add: order_mult_of)
      hence "x \<in> ?U" using dvd_nat_bounds[of "order (mult_of R)" "group.ord (mult_of R) x"] x by blast
    } thus "carrier (mult_of R) \<subseteq> ?U" by blast
  qed auto
  also have "card ... = order (mult_of R)"
    using order_mult_of finite' by (simp add: order_def)
  finally have sum_Ns_eq: "(\<Sum>d | d dvd order (mult_of R). ?N d) = order (mult_of R)" .

  { fix d assume d:"d dvd order (mult_of R)"
    have "card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = d} \<le> phi' d"
    proof cases
      assume "card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = d} = 0" thus ?thesis by presburger
      next
      assume "card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = d} \<noteq> 0"
      hence "\<exists>a \<in> carrier (mult_of R). group.ord (mult_of R) a = d" by (auto simp: card_eq_0_iff)
      thus ?thesis using num_elems_of_ord_eq_phi'[OF finite d] by auto
    qed
  }
  hence all_le:"\<And>i. i \<in> {d. d dvd order (mult_of R) }
        \<Longrightarrow> (\<lambda>i. card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = i}) i \<le> (\<lambda>i. phi' i) i" by fast
  hence le:"(\<Sum>i | i dvd order (mult_of R). ?N i)
            \<le> (\<Sum>i | i dvd order (mult_of R). phi' i)"
            using setsum_mono[of "{d .  d dvd order (mult_of R)}"
                  "\<lambda>i. card {a \<in> carrier (mult_of R). group.ord (mult_of R) a = i}"] by presburger
  have "order (mult_of R) = (\<Sum>d | d dvd order (mult_of R). phi' d)" using *
    by (simp add: sum_phi'_factors)
  hence eq:"(\<Sum>i | i dvd order (mult_of R). ?N i)
          = (\<Sum>i | i dvd order (mult_of R). phi' i)" using le sum_Ns_eq by presburger
  have "\<And>i. i \<in> {d. d dvd order (mult_of R) } \<Longrightarrow> ?N i = (\<lambda>i. phi' i) i"
  proof (rule ccontr)
    fix i
    assume i1:"i \<in> {d. d dvd order (mult_of R)}" and "?N i \<noteq> phi' i"
    hence "?N i = 0"
      using num_elems_of_ord_eq_phi'[OF finite, of i] by (auto simp: card_eq_0_iff)
    moreover  have "0 < i" using * i1 by (simp add: dvd_nat_bounds[of "order (mult_of R)" i])
    ultimately have "?N i < phi' i" using phi'_nonzero by presburger
    hence "(\<Sum>i | i dvd order (mult_of R). ?N i)
         < (\<Sum>i | i dvd order (mult_of R). phi' i)"
      using setsum_strict_mono_ex1[OF fin, of "?N" "\<lambda> i . phi' i"]
            i1 all_le by auto
    thus False using eq by force
  qed
  hence "?N (order (mult_of R)) > 0" using * by (simp add: phi'_nonzero)
  then obtain a where a:"a \<in> carrier (mult_of R)" and a_ord:"group.ord (mult_of R) a = order (mult_of R)"
    by (auto simp add: card_gt_0_iff)
  hence set_eq:"{a(^)i | i::nat. i \<in> UNIV} = (\<lambda>x. a(^)x) ` {0 .. group.ord (mult_of R) a - 1}"
    using G.ord_elems[OF finite'] by auto
  have card_eq:"card ((\<lambda>x. a(^)x) ` {0 .. group.ord (mult_of R) a - 1}) = card {0 .. group.ord (mult_of R) a - 1}"
    by (intro card_image G.ord_inj finite' a)
  hence "card ((\<lambda> x . a(^)x) ` {0 .. group.ord (mult_of R) a - 1}) = card {0 ..order (mult_of R) - 1}"
    using assms by (simp add: card_eq a_ord)
  hence card_R_minus_1:"card {a(^)i | i::nat. i \<in> UNIV} =  order (mult_of R)"
    using * by (subst set_eq) auto
  have **:"{a(^)i | i::nat. i \<in> UNIV} \<subseteq> carrier (mult_of R)"
    using G.nat_pow_closed[OF a] by auto
  with _ have "carrier (mult_of R) = {a(^)i|i::nat. i \<in> UNIV}"
    by (rule card_seteq[symmetric]) (simp_all add: card_R_minus_1 finite order_def del: UNIV_I)
  thus ?thesis using a by blast
qed

text {*
  This result can be transferred to the multiplicative group of
  $\mathbb{Z}/p\mathbb{Z}$ for $p$ prime. *}

lemma mod_nat_int_pow_eq:
  fixes n :: nat and p a :: int
  assumes "a \<ge> 0" "p \<ge> 0"
  shows "(nat a ^ n) mod (nat p) = nat ((a ^ n) mod p)"
  using assms
  by (simp add: int_one_le_iff_zero_less nat_mod_distrib order_less_imp_le nat_power_eq[symmetric])

theorem residue_prime_mult_group_has_gen :
 fixes p :: nat
 assumes prime_p : "prime p"
 shows "\<exists>a \<in> {1 .. p - 1}. {1 .. p - 1} = {a^i mod p|i . i \<in> UNIV}"
proof -
  have "p\<ge>2" using prime_gt_1_nat[OF prime_p] by simp
  interpret R:residues_prime "int p" "residue_ring (int p)" unfolding residues_prime_def
    by (simp add: transfer_int_nat_prime prime_p)
  have car: "carrier (residue_ring (int p)) - {\<zero>\<^bsub>residue_ring (int p)\<^esub>} =  {1 .. int p - 1}"
    by (auto simp add: R.zero_cong R.res_carrier_eq)
  obtain a where a:"a \<in> {1 .. int p - 1}"
         and a_gen:"{1 .. int p - 1} = {a(^)\<^bsub>residue_ring (int p)\<^esub>i|i::nat . i \<in> UNIV}"
    apply atomize_elim using field.finite_field_mult_group_has_gen[OF R.is_field]
    by (auto simp add: car[symmetric] carrier_mult_of)
  { fix x fix i :: nat assume x: "x \<in> {1 .. int p - 1}"
    hence "x (^)\<^bsub>residue_ring (int p)\<^esub> i = x ^ i mod (int p)" using R.pow_cong[of x i] by auto}
  note * = this
  have **:"nat ` {1 .. int p - 1} = {1 .. p - 1}" (is "?L = ?R")
  proof
    { fix n assume n: "n \<in> ?L"
      then have "n \<in> ?R" using `p\<ge>2` by force
    } thus "?L \<subseteq> ?R" by blast
    { fix n assume n: "n \<in> ?R"
      then have "n \<in> ?L" using `p\<ge>2` Set_Interval.transfer_nat_int_set_functions(2) by fastforce
    } thus "?R \<subseteq> ?L" by blast
  qed
  have "nat ` {a^i mod (int p) | i::nat. i \<in> UNIV} = {nat a^i mod p | i . i \<in> UNIV}" (is "?L = ?R")
  proof
    { fix x assume x: "x \<in> ?L"
      then obtain i where i:"x = nat (a^i mod (int p))" by blast
      hence "x = nat a ^ i mod p" using mod_nat_int_pow_eq[of a "int p" i] a `p\<ge>2` by auto
      hence "x \<in> ?R" using i by blast
    } thus "?L \<subseteq> ?R" by blast
    { fix x assume x: "x \<in> ?R"
      then obtain i where i:"x = nat a^i mod p" by blast
      hence "x \<in> ?L" using mod_nat_int_pow_eq[of a "int p" i] a `p\<ge>2` by auto
    } thus "?R \<subseteq> ?L" by blast
  qed
  hence "{1 .. p - 1} = {nat a^i mod p | i. i \<in> UNIV}"
    using * a a_gen ** by presburger
  moreover
  have "nat a \<in> {1 .. p - 1}" using a by force
  ultimately show ?thesis ..
qed

end


(*  Title:    Irreducible.thy
    Author:   Max Wagner
*)

section \<open>Minimality under Irreducible Control Flow\<close>

txt \<open>Braun~et~al.~\cite{braun13cc} provide an extension to the original construction algorithm to ensure
minimality according to Cytron's definition even in the case of irreducible control flow. This extension
establishes the property of being \emph{redundant-scc-free}, i.e.\ the resulting graph $G$ contains no
subsets inducing a strongly connected subgraph $G'$ via \pf s such that $G'$ has less than two
$\phi$ arguments in $G\setminus G'$. In this section we will show that a graph with this property is Cytron-minimal.

Our formalization follows the proof sketch given in \cite{braun13cc}.
We first provide a formal proof of Lemma 1 from \cite{braun13cc} which states that every redundant set of \pf s contains at least one redundant SCC.
A redundant set of \pf s is a set $P$ of \pf s with $P \cup \{v\} \supseteq A$, where $A$ is the union over all \pf s arguments contained in $P$.
I.e.\ $P$ references at most one SSA value ($v$) outside $P$.
A redundant SCC is a redundant set that is strongly connected according to the \emph{is-argument} relation.

Next, we show that a CFG in SSA form without redundant sets of \pf s is Cytron-minimal.

Finally putting those results together, we conclude that the extension to Braun~et~al.'s algorithm always produces minimal SSA form.
\<close>

theory Irreducible
  imports Formal_SSA.Minimality
begin

context CFG_SSA_Transformed
begin

subsection \<open>Proof of Lemma 1 from Braun~et~al.\<close>

txt \<open>To preserve readability, we won't distinguish between graph nodes and the \pf s contained inside such a node.\<close>

txt \<open>The graph induced by the $\phi$ network contained in the vertex set @{term P}. Note that the edges
of this graph are not necessarily a subset of the edges of the input graph.\<close>
definition "induced_phi_graph g P \<equiv> {(\<phi>,\<phi>'). phiArg g \<phi> \<phi>'} \<inter> P \<times> P"

txt \<open>For the purposes of this section, we define a "redundant set" as a nonempty set of \pf s with
at most one $\phi$ argument outside itself. A redundant SCC is defined analogously. Note that since
any uses of values in a redundant set can be replaced by uses of its singular argument (without
modifying program semantics), the name is adequate.\<close>
definition "redundant_set g P \<equiv> P \<noteq> {} \<and> P \<subseteq> dom (phi g) \<and> (\<exists>v' \<in> allVars g. \<forall>\<phi> \<in> P. \<forall>\<phi>'. phiArg g \<phi> \<phi>' \<longrightarrow> \<phi>' \<in> P \<union> {v'})"
definition "redundant_scc g P scc \<equiv> redundant_set g scc \<and> is_scc (induced_phi_graph g P) scc"

txt \<open>We prove an important lemma via condensation graphs of $\phi$ networks, so the relevant definitions are introduced here.\<close>
definition "condensation_nodes g P \<equiv> scc_of (induced_phi_graph g P) ` P"
definition "condensation_edges g P \<equiv> ((\<lambda>(x,y). (scc_of (induced_phi_graph g P) x, scc_of (induced_phi_graph g P) y)) ` (induced_phi_graph g P)) - Id"

txt \<open>For a finite @{term P}, the condensation graph induced by @{term P} is finite and acyclic.\<close>

lemma condensation_finite: "finite (condensation_edges g P)"
txt \<open>The set of edges of the condensation graph, spanning at most all $\phi$ nodes and their arguments (both of which are finite sets), is finite itself.\<close>
proof -
  let ?phiEdges="{(a,b). phiArg g a b}"
  have "finite ?phiEdges"
  proof -
    let ?phiDomRan="(dom (phi g) \<times> \<Union> (set ` (ran (phi g))))"
    from phi_finite
    have "finite ?phiDomRan" by (simp add: imageE phi_finite map_dom_ran_finite)
    have "?phiEdges \<subseteq> ?phiDomRan"
     apply (rule subst[of "\<forall>a \<in> ?phiEdges. a \<in> ?phiDomRan"])
      apply (simp_all add: subset_eq[symmetric] phiArg_def)
     by (auto simp: ran_def)
    with \<open>finite ?phiDomRan\<close>
    show "finite ?phiEdges" by (rule Finite_Set.rev_finite_subset)
  qed
  hence "\<And>f. finite (f ` (?phiEdges \<inter> (P \<times> P)))" by auto
  thus "finite (condensation_edges g P)" unfolding condensation_edges_def induced_phi_graph_def by auto
qed

txt \<open>auxiliary lemmas for acyclicity\<close>

lemma condensation_nodes_edges: "(condensation_edges g P) \<subseteq> (condensation_nodes g P \<times> condensation_nodes g P)"
unfolding condensation_edges_def condensation_nodes_def induced_phi_graph_def
by auto

lemma condensation_edge_impl_path:
assumes "(a, b) \<in> (condensation_edges g P)"
assumes "(\<phi>\<^sub>a \<in> a)"
assumes "(\<phi>\<^sub>b \<in> b)"
shows "(\<phi>\<^sub>a, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*"
unfolding condensation_edges_def
proof -
  from assms(1)
  obtain x y where x_y_props:
    "(x, y) \<in> (induced_phi_graph g P)"
    "a = scc_of (induced_phi_graph g P) x"
    "b = scc_of (induced_phi_graph g P) y"
   unfolding condensation_edges_def by auto
  hence "x \<in> a" "y \<in> b" by auto

  txt \<open>All that's left is to combine these paths.\<close>
  with assms(2) x_y_props(2)
  have "(\<phi>\<^sub>a, x) \<in> (induced_phi_graph g P)\<^sup>*" by (meson is_scc_connected scc_of_is_scc)
  moreover with assms(3) x_y_props(3) \<open>y \<in> b\<close>
  have "(y, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*" by (meson is_scc_connected scc_of_is_scc)
  ultimately
  show "(\<phi>\<^sub>a, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*" using x_y_props(1)  by auto
qed

lemma path_in_condensation_impl_path:
assumes "(a, b) \<in> (condensation_edges g P)\<^sup>+"
assumes "(\<phi>\<^sub>a \<in> a)"
assumes "(\<phi>\<^sub>b \<in> b)"
shows "(\<phi>\<^sub>a, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*"
using assms
proof (induction arbitrary: \<phi>\<^sub>b rule:trancl_induct)
  fix y z \<phi>\<^sub>b
  assume "(y, z) \<in> condensation_edges g P"

  hence "is_scc (induced_phi_graph g P) y" unfolding condensation_edges_def by auto
  hence "\<exists>\<phi>\<^sub>y. \<phi>\<^sub>y \<in> y" using scc_non_empty' by auto
  then obtain \<phi>\<^sub>y where \<phi>\<^sub>y_in_y: "\<phi>\<^sub>y \<in> y" by auto

  assume \<phi>\<^sub>b_elem: "\<phi>\<^sub>b \<in> z"
  assume "\<And>\<phi>\<^sub>b. \<phi>\<^sub>a \<in> a \<Longrightarrow> \<phi>\<^sub>b \<in> y \<Longrightarrow> (\<phi>\<^sub>a, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*"
  with assms(2) \<phi>\<^sub>y_in_y
  have \<phi>\<^sub>a_to_\<phi>\<^sub>y: "(\<phi>\<^sub>a, \<phi>\<^sub>y) \<in> (induced_phi_graph g P)\<^sup>*" using condensation_edge_impl_path by auto

  from \<phi>\<^sub>b_elem \<phi>\<^sub>y_in_y \<open>(y, z) \<in> condensation_edges g P\<close>
  have "(\<phi>\<^sub>y, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*" using condensation_edge_impl_path by auto
  with \<phi>\<^sub>a_to_\<phi>\<^sub>y
  show "(\<phi>\<^sub>a, \<phi>\<^sub>b) \<in> (induced_phi_graph g P)\<^sup>*"  by auto
qed (auto intro:condensation_edge_impl_path)

lemma condensation_acyclic: "acyclic (condensation_edges g P)"
proof (rule acyclicI, rule allI, rule ccontr, simp)
  fix x
  txt \<open>Assume there is a cycle in the condensation graph.\<close>
  assume cyclic: "(x, x) \<in> (condensation_edges g P)\<^sup>+"
  have nonrefl: "(x, x) \<notin> (condensation_edges g P)" unfolding condensation_edges_def by auto
  txt \<open>Then there must be a second SCC \<open>b\<close> on this path.\<close>
  from this cyclic
  obtain b where b_on_path: "(x, b) \<in> (condensation_edges g P)" "(b, x) \<in> (condensation_edges g P)\<^sup>+"
   by (meson converse_tranclE)

  hence "x \<in> (condensation_nodes g P)" "b \<in> (condensation_nodes g P)" using condensation_nodes_edges by auto
  hence nodes_are_scc: "is_scc (induced_phi_graph g P) x" "is_scc (induced_phi_graph g P) b"
    using scc_of_is_scc unfolding induced_phi_graph_def condensation_nodes_def by auto

  txt \<open>However, the existence of this path means all nodes in @{term b} and @{term x} are mutually reachable.\<close>
  have "\<exists>\<phi>\<^sub>x. \<phi>\<^sub>x \<in> x" "\<exists>\<phi>\<^sub>b. \<phi>\<^sub>b \<in> b" using nodes_are_scc scc_non_empty' ex_in_conv by auto
  then obtain \<phi>\<^sub>x \<phi>\<^sub>b where \<phi>xb_elem: "\<phi>\<^sub>x \<in> x" "\<phi>\<^sub>b \<in> b" by metis
  with nodes_are_scc(1) b_on_path path_in_condensation_impl_path condensation_edge_impl_path \<phi>xb_elem(2)
  have "\<phi>\<^sub>b \<in> x"
   by - (rule is_scc_closed)
  txt \<open>This however means @{term x} and @{term b} must be the same SCC, which is a contradiction to the nonreflexivity of @{theory_text condensation_edges}.\<close>
  with nodes_are_scc \<phi>xb_elem
  have "x = b" using is_scc_unique[of "induced_phi_graph g P"] by simp
  hence "(x, x) \<in> (condensation_edges g P)" using b_on_path by simp
  with nonrefl
  show "False" by simp
qed

txt \<open>Since the condensation graph of a set is acyclic and finite, it must have a leaf.\<close>
lemma Ex_condensation_leaf:
assumes "P \<noteq> {}"
shows "\<exists>leaf. leaf \<in> (condensation_nodes g P) \<and> (\<forall> scc.(leaf, scc) \<notin> condensation_edges g P)"
proof -
  from assms obtain x where "x \<in> condensation_nodes g P" unfolding condensation_nodes_def by auto
  show ?thesis
  proof (rule wfE_min)
    from condensation_finite condensation_acyclic
    show "wf ((condensation_edges g P)\<inverse>)" by (rule finite_acyclic_wf_converse)
  next
    fix leaf
    assume leaf_node: "leaf \<in> condensation_nodes g P"
    moreover
    assume leaf_is_leaf: "scc \<notin> condensation_nodes g P" if "(scc, leaf) \<in> (condensation_edges g P)\<inverse>" for scc
    ultimately
    have "leaf \<in> condensation_nodes g P \<and> (\<forall>scc. (leaf, scc) \<notin> condensation_edges g P)" using condensation_nodes_edges by blast
    thus "\<exists>leaf. leaf \<in> condensation_nodes g P \<and> (\<forall>scc. (leaf, scc) \<notin> condensation_edges g P)" by blast
  qed fact
qed

lemma scc_in_P:
assumes "scc \<in> condensation_nodes g P"
shows "scc \<subseteq> P"
proof -
  have "scc \<subseteq> P" if y_props: "scc = scc_of (induced_phi_graph g P) n" "n \<in> P" for n
  proof -
    from y_props
    show "scc \<subseteq> P"
    proof (clarsimp simp:y_props(1); case_tac "n = x")
      fix x
      assume different: "n \<noteq> x"
      assume "x \<in> scc_of (induced_phi_graph g P) n"
      hence "(n, x) \<in> (induced_phi_graph g P)\<^sup>*" by (metis is_scc_connected scc_of_is_scc node_in_scc_of_node)
      with different
      have "(n, x) \<in> (induced_phi_graph g P)\<^sup>+" by (metis rtranclD)
      then obtain z where step: "(z, x) \<in> (induced_phi_graph g P)" by (meson tranclE)
      from step
      show "x \<in> P" unfolding induced_phi_graph_def by auto
    qed simp
  qed
  from this assms(1) have "x \<in> P" if x_node: "x \<in> scc" for x
   apply -
   apply (rule imageE[of scc "scc_of (induced_phi_graph g P)"])
    using condensation_nodes_def x_node by blast+
  thus ?thesis by clarify
qed

lemma redundant_scc_phis:
assumes "redundant_set g P" "scc \<in> condensation_nodes g P" "x \<in> scc"
shows "phi g x \<noteq> None"
using assms by (meson domIff redundant_set_def scc_in_P subsetCE)

txt \<open>The following lemma will be important for the main proof of this section.
If @{term P} is redundant, a leaf in the condensation graph induced by P corresponds to a strongly connected set
with at most one argument, thus a redundant strongly connected set exists.\<close>

txt \<open>Lemma 1. Every redundant set contains a redundant SCC.\<close>

lemma 1:
assumes "redundant_set g P"
shows "\<exists>scc \<subseteq> P. redundant_scc g P scc"
proof -
  from assms Ex_condensation_leaf[of P g]
  obtain leaf where leaf_props: "leaf \<in> (condensation_nodes g P)" "\<forall>scc. (leaf, scc) \<notin> condensation_edges g P"
   unfolding redundant_set_def by auto
  hence "is_scc (induced_phi_graph g P) leaf" unfolding condensation_nodes_def by auto
  moreover
  hence "leaf \<noteq> {}" by (rule scc_non_empty')
  moreover
  have "leaf \<subseteq> dom (phi g)"
    apply (subst subset_eq, rule ballI)
    using redundant_scc_phis leaf_props(1) assms(1) by auto
  moreover
  from assms
  obtain pred where pred_props: "pred \<in> allVars g" "\<forall>\<phi>\<in>P. \<forall>\<phi>'. phiArg g \<phi> \<phi>' \<longrightarrow> \<phi>' \<in> P \<union> {pred}" unfolding redundant_set_def by auto
  {
    txt \<open>Any argument of a \pf\ in the leaf SCC which is \emph{not} in the leaf SCC itself must be the unique argument of P\<close>
    fix \<phi> \<phi>'

    consider (in_P) "\<phi>' \<notin> leaf \<and> \<phi>' \<in> P" | (neither) "\<phi>' \<notin> leaf \<and> \<phi>' \<notin> P \<union> {pred}" | "\<phi>' \<notin> leaf \<and> \<phi>' \<in> {pred}" | "\<phi>' \<in> leaf" by auto
    hence "\<phi>' \<in> leaf \<union> {pred}" if "\<phi> \<in> leaf" and "phiArg g \<phi> \<phi>'"
    proof cases
      case in_P \<comment> \<open>In this case @{term leaf} wasn't really a leaf, a contradiction\<close>
      moreover
      from in_P that leaf_props(1) scc_in_P[of leaf g P]
      have "(\<phi>, \<phi>') \<in> induced_phi_graph g P" unfolding induced_phi_graph_def by auto
      ultimately
      have "(leaf, scc_of (induced_phi_graph g P) \<phi>') \<in> condensation_edges g P" unfolding condensation_edges_def
       using leaf_props(1) that \<open>is_scc (induced_phi_graph g P) leaf\<close>
       apply -
       apply clarsimp
       apply (rule conjI)
        prefer 2
        apply auto[1]
       unfolding condensation_nodes_def
       by (metis (no_types, lifting) is_scc_unique node_in_scc_of_node pair_imageI scc_of_is_scc)
      with leaf_props(2)
      show ?thesis by auto
    next
      case neither \<comment> \<open>In which case @{term P} itself wasn't redundant, a contradiction\<close>
      with that leaf_props pred_props
      have "\<not>redundant_set g P" unfolding redundant_set_def
        by (meson rev_subsetD scc_in_P)
      with assms
      show ?thesis by auto
    qed auto \<comment> \<open>the other cases are trivial\<close>
  }
  with pred_props(1)
  have "\<exists>v'\<in>allVars g. \<forall>\<phi>\<in>leaf. \<forall>\<phi>'. phiArg g \<phi> \<phi>' \<longrightarrow> \<phi>' \<in> leaf \<union> {v'}"  by auto
  ultimately
  have "redundant_scc g P leaf" unfolding redundant_scc_def redundant_set_def by auto
  thus ?thesis using leaf_props(1) scc_in_P by meson
qed

subsection \<open>Proof of Minimality\<close>

txt \<open>We inductively define the reachable-set of a \pf\ as all \pf s reachable from a given node via an
unbroken chain of $\phi$ argument edges to unnecessary \pf s.\<close>

inductive_set reachable :: "'g \<Rightarrow> 'val \<Rightarrow> 'val set"
  for g :: "'g" and \<phi> :: "'val"
  where refl: "unnecessaryPhi g \<phi> \<Longrightarrow> \<phi> \<in> reachable g \<phi>"
  | step: "\<phi>' \<in> reachable g \<phi> \<Longrightarrow> phiArg g \<phi>' \<phi>'' \<Longrightarrow> unnecessaryPhi g \<phi>'' \<Longrightarrow> \<phi>'' \<in> reachable g \<phi>"

lemma reachable_props:
  assumes "\<phi>' \<in> reachable g \<phi>"
  shows "(phiArg g)\<^sup>*\<^sup>* \<phi> \<phi>'" and "unnecessaryPhi g \<phi>'"
  using assms
  by (induction \<phi>' rule: reachable.induct) auto

txt \<open>We call the transitive arguments of a \pf\ not in its reachable-set the "true arguments" of this \pf.\<close>
definition [simp]: "trueArgs g \<phi> \<equiv> {\<phi>'. \<phi>' \<notin> reachable g \<phi>} \<inter> {\<phi>'. \<exists>\<phi>'' \<in> reachable g \<phi>. phiArg g \<phi>'' \<phi>'}"

lemma preds_finite: "finite (trueArgs g \<phi>)"
proof (rule ccontr)
  assume "infinite (trueArgs g \<phi>)"
  hence a: "infinite {\<phi>'. \<exists>\<phi>'' \<in> reachable g \<phi>. phiArg g \<phi>'' \<phi>'}" by auto
  have phiarg_set: "{\<phi>'. \<exists>\<phi>. phiArg g \<phi> \<phi>'} = \<Union> (set `{b. \<exists>a. phi g a = Some b})" unfolding phiArg_def by auto
  txt \<open>If the true arguments of a \pf\ are infinite in number, there must be an infinite number of \pf s\ldots\<close>
  have "infinite {\<phi>'. \<exists>\<phi>. phiArg g \<phi> \<phi>'}"
    by (rule infinite_super[of "{\<phi>'. \<exists>\<phi>'' \<in> reachable g \<phi>. phiArg g \<phi>'' \<phi>'}"])  (auto simp: a)
  with phiarg_set
  have "infinite (ran (phi g))" unfolding ran_def phiArg_def by clarsimp
  txt \<open>Which cannot be.\<close>
  thus False by (simp add:phi_finite map_dom_ran_finite)
qed

txt \<open>Any unnecessary $\phi$ with less than 2 true arguments induces with @{term "reachable g \<phi>"} a redundant set itself.\<close>

lemma few_preds_redundant:
assumes "card (trueArgs g \<phi>) < 2" "unnecessaryPhi g \<phi>"
shows "redundant_set g (reachable g \<phi>)"
unfolding redundant_set_def
proof (intro conjI)
  from assms
  show "reachable g \<phi> \<noteq> {}"
    using empty_iff reachable.intros(1) by auto
next
  from assms(2)
  show "reachable g \<phi> \<subseteq> dom (phi g)"
    by (metis domIff reachable.cases subsetI unnecessaryPhi_def)
next
  from assms(1)
  consider (single) "card (trueArgs g \<phi>) = 1" | (empty) "card (trueArgs g \<phi>) = 0" by force
  thus "\<exists>pred\<in>allVars g. \<forall>\<phi>'\<in>reachable g \<phi>. \<forall>\<phi>''. phiArg g \<phi>' \<phi>'' \<longrightarrow> \<phi>'' \<in> reachable g \<phi> \<union> {pred}"
  proof cases
    case single
    then obtain pred where pred_prop: "trueArgs g \<phi> = {pred}" using card_eq_1_singleton by blast
    hence "pred \<in> allVars g" by (auto intro: Int_Collect phiArg_in_allVars)
    moreover
    from pred_prop
    have "\<forall>\<phi>'\<in>reachable g \<phi>. \<forall>\<phi>''. phiArg g \<phi>' \<phi>'' \<longrightarrow> \<phi>'' \<in> reachable g \<phi> \<union> {pred}" by auto
    ultimately
    show ?thesis by auto
  next
    case empty
    from allDefs_in_allVars[of _ g "defNode g \<phi>"] assms
    have phi_var: "\<phi> \<in> allVars g" unfolding unnecessaryPhi_def phiDefs_def allDefs_def defNode_def phi_def trueArgs_def
      by (clarsimp simp: domIff phis_in_\<alpha>n)
    from empty assms(1)
    have no_preds: "trueArgs g \<phi> = {}"  by (subst card_0_eq[OF preds_finite, symmetric]) auto
    show ?thesis
    proof (rule bexI, rule ballI, rule allI, rule impI)
      fix \<phi>' \<phi>''
      assume phis_props: "\<phi>' \<in> reachable g \<phi>" "phiArg g \<phi>' \<phi>''"
      with no_preds
      have "\<phi>'' \<in> reachable g \<phi>"
      unfolding trueArgs_def
      proof -
        from phis_props
        have "\<phi>'' \<in> {\<phi>'. \<exists>\<phi>''\<in>reachable g \<phi>. phiArg g \<phi>'' \<phi>'}" by auto
        with phis_props no_preds
        show "\<phi>'' \<in> reachable g \<phi>" unfolding trueArgs_def by auto
      qed
      thus "\<phi>'' \<in> reachable g \<phi> \<union> {\<phi>}" by simp
    qed (auto simp: phi_var)
  qed
qed

lemma phiArg_trancl_same_var:
assumes "(phiArg g)\<^sup>+\<^sup>+ \<phi> n"
shows "var g \<phi> = var g n"
using assms
apply (induction rule: tranclp_induct)
  apply (rule phiArg_same_var[symmetric])
  apply simp
 using phiArg_same_var by auto

txt \<open>The following path extension lemma will be used a number of times in the inner induction of the
main proof. Basically, the idea is to extend a path ending in a $\phi$ argument to the corresponding \pf\
while preserving disjointness to a second path.\<close>

lemma phiArg_disjoint_paths_extend:
assumes "var g r = V" and "var g s = V" and "r \<in> allVars g" and "s \<in> allVars g"
and "V \<in> oldDefs g n" and "V \<in> oldDefs g m"
and "g \<turnstile> n-ns\<rightarrow>defNode g r" and "g \<turnstile> m-ms\<rightarrow>defNode g s"
and "set ns \<inter> set ms = {}"
and "phiArg g \<phi>\<^sub>r r"
obtains ns'
where "g \<turnstile> n-ns@ns'\<rightarrow>defNode g \<phi>\<^sub>r"
and "set (butlast (ns@ns')) \<inter> set ms = {}"
proof (cases "r = \<phi>\<^sub>r")
  case (True)
  txt \<open>If the node to extend the path to is already the endpoint, the lemma is trivial.\<close>
  with assms(7,8,9) in_set_butlastD
  have "g \<turnstile> n-ns@[]\<rightarrow>defNode g \<phi>\<^sub>r" "set (butlast (ns@[])) \<inter> set ms = {}"
    by simp_all fastforce
  with that show ?thesis .
next
  case False
  txt \<open>It suffices to obtain any path from r to @{term \<phi>\<^sub>r}.
     However, since we'll need the corresponding predecessor of @{term \<phi>\<^sub>r} later, we must do this as follows:\<close>
  from assms(10)
  have "\<phi>\<^sub>r \<in> allVars g" unfolding phiArg_def
    by (metis allDefs_in_allVars phiDefs_in_allDefs phi_def phi_phiDefs phis_in_\<alpha>n)
  with assms(10)
  obtain rs' pred\<^sub>\<phi>\<^sub>r where rs'_props: "g \<turnstile> defNode g r-rs'\<rightarrow> pred\<^sub>\<phi>\<^sub>r" "old.EntryPath g rs'" "r \<in> phiUses g pred\<^sub>\<phi>\<^sub>r" "pred\<^sub>\<phi>\<^sub>r \<in> set (old.predecessors g (defNode g \<phi>\<^sub>r))"
   by (rule phiArg_path_ex')

  define rs where "rs = rs'@[defNode g \<phi>\<^sub>r]"
  from rs'_props(2,1) old.EntryPath_distinct old.path2_hd
  have rs'_loopfree: "defNode g r \<notin> set (tl rs')"  by (simp add: Misc.distinct_hd_tl)

  from False assms have "defNode g \<phi>\<^sub>r \<noteq> defNode g r"
   apply -
   apply (rule phiArg_distinct_nodes)
     apply (auto intro:phiArg_in_allVars)[2]
   unfolding phiArg_def by (metis allDefs_in_allVars phiDefs_in_allDefs phi_def phi_phiDefs phis_in_\<alpha>n)

  from rs'_props
  have rs_props: "g \<turnstile> defNode g r-rs\<rightarrow> defNode g \<phi>\<^sub>r" "length rs > 1" "defNode g r \<notin> set (tl rs)"
     apply (subgoal_tac "defNode g r = hd rs'")
      prefer 2 using rs'_props(1)
     apply (rule old.path2_hd)
     using old.path2_snoc old.path2_def rs'_props(1) rs_def rs'_loopfree \<open>defNode g \<phi>\<^sub>r \<noteq> defNode g r\<close> by auto

  show thesis
  proof (cases "set (butlast rs) \<inter> set ms = {}")
    case inter_empty: True
    txt \<open>If the intersection of these is empty, @{term "tl rs"} is already the extension we're looking for\<close>
    show thesis
    proof (rule that)
      show "set (butlast (ns @ tl rs)) \<inter> set ms = {}"
      proof (rule ccontr, simp only: ex_in_conv[symmetric])
        assume "\<exists>x. x \<in> set (butlast (ns @ tl rs)) \<inter> set ms"
        then obtain x where x_props: "x \<in> set (butlast (ns @ tl rs))" "x \<in> set ms" by auto
        with rs_props(2)
        consider (in_ns) "x \<in> set ns" | (in_rs) "x \<in> set (butlast (tl rs))" by (metis Un_iff butlast_append in_set_butlastD set_append)
        thus False
         apply (cases)
          using x_props(2) assms(9)
          apply (simp add: disjoint_elem)
         by (metis x_props(2) inter_empty in_set_tlD List.butlast_tl disjoint_iff_not_equal)
      qed
    qed (auto intro:assms(7) rs_props(1) old.path2_app)
  next
    case inter_ex: False
    txt \<open>If the intersection is nonempty, there must be a first point of intersection @{term i}.\<close>
    from inter_ex assms(7,8) rs_props
    obtain i ri where ri_props: "g \<turnstile> defNode g r-ri\<rightarrow>i" "i \<in> set ms" "\<forall>n \<in> set (butlast ri). n \<notin> set ms" "prefix ri rs"
     apply -
     apply (rule old.path2_split_first_prop[of g "defNode g r" rs "defNode g \<phi>\<^sub>r", where P="\<lambda>m. m \<in> set ms"])
       apply blast
      apply (metis disjoint_iff_not_equal in_set_butlastD)
     by blast
    with assms(8) old.path2_prefix_ex
    obtain ms' where ms'_props: "g \<turnstile> m -ms'\<rightarrow> i" "prefix ms' ms" "i \<notin> set (butlast ms')" by blast

    txt \<open>We proceed by case distinction:
      \<^item> if @{prop "i = defNode g \<phi>\<^sub>r"}, the path @{term ri} is already the path extension we're looking for
      \<^item> Otherwise, the fact that @{term i} is on the path from $\phi$ argument to the $\phi$ itself leads to a contradiction.
        However, we still need to distinguish the cases of whether @{prop "m = i"}\<close>
    consider (ri_is_valid) "i = defNode g \<phi>\<^sub>r" | (m_i_same) "i \<noteq> defNode g \<phi>\<^sub>r" "m = i" | (m_i_differ) "i \<noteq> defNode g \<phi>\<^sub>r" "m \<noteq> i" by auto

    thus thesis
    proof (cases)
      case ri_is_valid
      txt \<open>@{term ri} is a valid path extension.\<close>
      with assms(7) ri_props(1)
      have "g \<turnstile> n -ns@(tl ri)\<rightarrow> defNode g \<phi>\<^sub>r" by auto

      moreover
      have "set (butlast (ns@(tl ri))) \<inter> set ms = {}"
      proof (rule ccontr)
        assume contr: "set (butlast (ns @ tl ri)) \<inter> set ms \<noteq> {}"
        from this
        obtain x where x_props: "x \<in> set (butlast (ns @ tl ri))" "x \<in> set ms" by auto
        with assms(9) have "x \<notin> set ns" by auto
        with x_props \<open>g \<turnstile> n-ns @ tl ri\<rightarrow>defNode g \<phi>\<^sub>r\<close> \<open>defNode g \<phi>\<^sub>r \<noteq> defNode g r\<close> assms(7)
        have "x \<in> set (butlast (tl ri))"
         by (metis Un_iff append_Nil2 butlast_append old.path2_last set_append)
        with x_props(2) ri_props(3)
        show "False" by (metis FormalSSA_Misc.in_set_tlD List.butlast_tl)
      qed
      ultimately
      show thesis by (rule that)
    next
      case m_i_same
      txt \<open>If @{prop "m = i"}, we have, with @{term m}, a variable definition on the path from a \pf\ to its argument.
          This constitutes a contradiction to the conventional property.\<close>
      note rs'_props(1) rs'_loopfree
      moreover have "r \<in> allDefs g (defNode g r)" by (simp add: assms(3))
      moreover from rs'_props(3) have "r \<in> allUses g pred\<^sub>\<phi>\<^sub>r" unfolding allUses_def by simp

      moreover
      from rs_props(1) m_i_same rs_def ri_props(1,2,4) \<open>defNode g \<phi>\<^sub>r \<noteq> defNode g r\<close> assms(7,9)
      have "m \<in> set (tl rs')"
       by (metis disjoint_elem hd_append in_hd_or_tl_conv in_prefix list.sel(1) old.path2_hd old.path2_last old.path2_last_in_ns prefix_snoc)

      moreover
      from assms(6) obtain def\<^sub>m where "def\<^sub>m \<in> allDefs g m" "var g def\<^sub>m = V" unfolding oldDefs_def using defs_in_allDefs by blast

      ultimately
      have "var g def\<^sub>m \<noteq> var g r" by - (rule conventional, simp_all)
      with \<open>var g def\<^sub>m = V\<close> assms(1)
      have "False" by simp
      thus ?thesis by simp

    next
      case m_i_differ
      txt \<open>If @{prop "m \<noteq> i"}, @{term i} constitutes a proper path convergence point.\<close>
      have "old.pathsConverge g m ms' n (ns @ tl ri) i"
      proof (rule old.pathsConvergeI)
        show "1 < length ms'" using m_i_differ ms'_props old.path2_nontriv by blast
      next
        show "1 < length (ns @ tl ri)"
        using ri_props old.path2_nontriv assms(9) by (metis assms(7) disjoint_elem old.path2_app old.path2_hd_in_ns)
      next
        show "set (butlast ms') \<inter> set (butlast (ns @ tl ri)) = {}"
        proof (rule ccontr)
          assume "set (butlast ms') \<inter> set (butlast (ns @ tl ri)) \<noteq> {}"
          then obtain i' where i'_props: "i' \<in> set (butlast ms')" "i' \<in> set (butlast (ns @ tl ri))" by auto
          with ms'_props(2)
          have i'_not_in_ms: "i' \<in> set (butlast ms)" by (metis in_set_butlast_appendI prefixE)

          with assms(9)
          show False
          proof (cases "i' \<notin> set ns")
            case True
            with i'_props(2)
            have "i' \<in> set (butlast (tl ri))"
             by (metis Un_iff butlast_append in_set_butlastD set_append)
            hence "i' \<in> set (butlast ri)" by (simp add:in_set_tlD List.butlast_tl)
            with i'_not_in_ms ri_props(3)
            show False by (auto dest:in_set_butlastD)
          qed (meson disjoint_elem in_set_butlastD)
        qed
      qed (auto intro: assms(7) ri_props(1) old.path2_app ms'_props(1))

      txt \<open>At this intersection of paths we can find a \pf.\<close>
      from this assms(6,5)
      have "necessaryPhi g V i" by (rule necessaryPhiI)

      txt \<open>Before we can conclude that there is indeed a $\phi$ at @{term i}, we have to prove a couple of technicalities\ldots\<close>
      moreover
      from m_i_differ ri_props(1,4) rs_def old.path2_last prefix_snoc
      have ri_rs'_prefix: "prefix ri rs'" by fastforce
      then obtain rs'_rest where rs'_rest_prop: "rs' = ri@rs'_rest" using prefixE by auto
      from old.path2_last[OF ri_props(1)] last_snoc[of _ i] obtain tmp where "ri = tmp@[i]"
       apply (subgoal_tac "ri \<noteq> []")
        prefer 2
        using ri_props(1) apply (simp add: old.path2_not_Nil)
       apply (rule_tac that)
       using append_butlast_last_id[symmetric] by auto
      with rs'_rest_prop have rs'_rest_def: "rs' = tmp@i#rs'_rest" by auto
      with rs'_props(1) have "g \<turnstile> i -i#rs'_rest\<rightarrow> pred\<^sub>\<phi>\<^sub>r"
       by (simp add:old.path2_split)
      moreover
      note \<open>var g r = V\<close> [simp]
      from rs'_props(3)
      have "r \<in> allUses g pred\<^sub>\<phi>\<^sub>r" unfolding allUses_def by simp

      moreover
      from \<open>defNode g r \<notin> set (tl rs')\<close> rs'_rest_def
      have "defNode g r \<notin> set rs'_rest" by auto
      with \<open>g \<turnstile> i -i#rs'_rest\<rightarrow> pred\<^sub>\<phi>\<^sub>r\<close>
      have "\<And>x. x \<in> set rs'_rest \<Longrightarrow> r \<notin> allDefs g x"
       by (metis defNode_eq list.distinct(1) list.sel(3) list.set_cases old.path2_cases old.path2_in_\<alpha>n)

      moreover
      from assms(7,9) \<open>g \<turnstile> i -i#rs'_rest\<rightarrow> pred\<^sub>\<phi>\<^sub>r\<close> ri_props(2)
      have "r \<notin> defs g i"
       by (metis defNode_eq defs_in_allDefs disjoint_elem old.path2_hd_in_\<alpha>n old.path2_last_in_ns)
      ultimately

      txt \<open>The convergence property gives us that there is a $\phi$ in the last node fulfilling @{theory_text necessaryPhi}
          on a path to a use of @{term r} without a definition of @{term r}.
          Thus @{term i} bears a \pf\ for the value of @{term r}.\<close>

      have "\<exists>y. phis g (i, r) = Some y"
       by (rule convergence_prop [where g=g and n=i and v=r and ns="i#rs'_rest", simplified])
      moreover

      from \<open>g \<turnstile> n-ns\<rightarrow>defNode g r\<close> have "defNode g r \<in> set ns" by auto
      with \<open>set ns \<inter> set ms = {}\<close> \<open>i \<in> set ms\<close> have "i \<noteq> defNode g r" by auto
      moreover

      from ms'_props(1) have "i \<in> set (\<alpha>n g)" by auto
      moreover

      have "defNode g r \<in> set (\<alpha>n g)" by (simp add: assms(3))

      txt \<open>However, we now have two definitions of @{term r}: one in @{term i}, and one in @{term "defNode g r"}, which we know to be distinct.
          This is a contradiction to the @{theory_text allDefs_disjoint}-property.\<close>
      ultimately have False
        using allDefs_disjoint [where g=g and n=i and m="defNode g r"]
        unfolding allDefs_def phiDefs_def
        apply clarsimp
        apply (erule_tac c=r in equalityCE)
        using phi_def phis_phi by auto
      thus ?thesis by simp
    qed
  qed
qed

lemma reachable_same_var:
assumes "\<phi>' \<in> reachable g \<phi>"
shows "var g \<phi> = var g \<phi>'"
using assms by (metis Nitpick.rtranclp_unfold phiArg_trancl_same_var reachable_props(1))

lemma \<phi>_node_no_defs:
assumes "unnecessaryPhi g \<phi>" "\<phi> \<in> allVars g" "var g \<phi> \<in> oldDefs g n"
shows "defNode g \<phi> \<noteq> n"
using assms simpleDefs_phiDefs_var_disjoint defNode(1) not_None_eq phi_phiDefs
  unfolding unnecessaryPhi_def by auto

lemma defNode_differ_aux:
assumes "\<phi>\<^sub>s \<in> reachable g \<phi>" "\<phi> \<in> allVars g" "s \<in> allVars g" "\<phi>\<^sub>s \<noteq> s" "var g \<phi> = var g s"
shows "defNode g \<phi>\<^sub>s \<noteq> defNode g s" unfolding reachable_def
proof (rule ccontr)
  assume "\<not> defNode g \<phi>\<^sub>s \<noteq> defNode g s"
  hence eq: "defNode g \<phi>\<^sub>s = defNode g s" by simp
  from assms(1)
  have vars_eq: "var g \<phi> = var g \<phi>\<^sub>s"
    apply -
    apply (cases "\<phi> = \<phi>\<^sub>s")
    apply simp
    apply (rule phiArg_trancl_same_var)
    apply (drule reachable_props)
    unfolding reachable_def by (meson IntD1 mem_Collect_eq rtranclpD)
  have \<phi>\<^sub>s_in_allVars: "\<phi>\<^sub>s \<in> allVars g" unfolding reachable_def
  proof (cases "\<phi> = \<phi>\<^sub>s")
    case False
    with assms(1)
    obtain \<phi>' where "phiArg g \<phi>' \<phi>\<^sub>s"  by (metis rtranclp.cases reachable_props(1))
    thus "\<phi>\<^sub>s \<in> allVars g" by (rule phiArg_in_allVars)
  next
    case eq: True
    with assms(2)
    show "\<phi>\<^sub>s \<in> allVars g" by (subst eq[symmetric])
  qed

  from eq \<phi>\<^sub>s_in_allVars assms(3,4)
  have "var g \<phi>\<^sub>s \<noteq> var g s" by - (rule defNode_var_disjoint)
  with vars_eq assms(5)
  show False by auto
qed

txt \<open>Theorem 1. A graph which does not contain any redundant set is minimal according to Cytron et al.'s definition of minimality.\<close>

theorem no_redundant_set_minimal:
assumes no_redundant_set: "\<not>(\<exists>P. redundant_set g P)"
shows "cytronMinimal g"
proof (rule ccontr)
  assume "\<not>cytronMinimal g"
  txt \<open>Assume the graph is not Cytron-minimal. Thus there is a \pf\ which does not sit at the
      convergence point of multiple liveness intervals.\<close>
  then obtain \<phi> where \<phi>_props: "unnecessaryPhi g \<phi>" "\<phi> \<in> allVars g" "\<phi> \<in> reachable g \<phi>"
  using cytronMinimal_def unnecessaryPhi_def reachable_def unnecessaryPhi_def reachable.intros by auto

  txt \<open>We consider the reachable-set of @{term \<phi>}. If @{term \<phi>} has less than two true arguments, we
     know it to be a redundant set, a contradiction. Otherwise, we know there to be at least two
     paths from different definitions leading into the reachable-set of @{term \<phi>}.\<close>

  consider (nontrivial) "card (trueArgs g \<phi>) \<ge> 2" | (trivial) "card (trueArgs g \<phi>) < 2" using linorder_not_le by auto
  thus False
  proof cases
    case trivial
    txt \<open>If there are less than 2 true arguments of this set, the set is trivially redundant (see @{theory_text few_preds_redundant}).\<close>
    from this \<phi>_props(1)
    have "redundant_set g (reachable g \<phi>)" by (rule few_preds_redundant)
    with no_redundant_set
    show False by simp
  next
    case nontrivial
    txt \<open>If there are two or more necessary arguments, there must be disjoint paths from Defs to two of these \pf s.\<close>
    then obtain r s \<phi>\<^sub>r \<phi>\<^sub>s where assign_nodes_props:
      "r \<noteq> s" "\<phi>\<^sub>r \<in> reachable g \<phi>" "\<phi>\<^sub>s \<in> reachable g \<phi>"
      "\<not> unnecessaryPhi g r" "\<not> unnecessaryPhi g s"
      "r \<in> {n. (phiArg g)\<^sup>*\<^sup>* \<phi> n}" "s \<in> {n. (phiArg g)\<^sup>*\<^sup>* \<phi> n}"
      "phiArg g \<phi>\<^sub>r r" "phiArg g \<phi>\<^sub>s s"
     apply simp
     apply (rule set_take_two[OF nontrivial])
     apply simp
     by (meson reachable.intros(2) reachable_props(1) rtranclp_tranclp_tranclp tranclp.r_into_trancl tranclp_into_rtranclp)
    moreover from assign_nodes_props
    have \<phi>_r_s_uneq: "\<phi> \<noteq> r" "\<phi> \<noteq> s" using \<phi>_props by auto
    moreover
    from assign_nodes_props this
    have r_s_in_tranclp: "(phiArg g)\<^sup>+\<^sup>+ \<phi> r" "(phiArg g)\<^sup>+\<^sup>+ \<phi> s"
      by (meson mem_Collect_eq rtranclpD) (meson assign_nodes_props(7) \<phi>_r_s_uneq(2) mem_Collect_eq rtranclpD)
    from this
    obtain V where V_props: "var g r = V" "var g s = V" "var g \<phi> = V" by (metis phiArg_trancl_same_var)
    moreover
    from r_s_in_tranclp
    have r_s_allVars: "r \<in> allVars g" "s \<in> allVars g" by (metis phiArg_in_allVars tranclp.cases)+
    moreover
    from V_props defNode_var_disjoint r_s_allVars assign_nodes_props(1)
    have r_s_defNode_distinct: "defNode g r \<noteq> defNode g s" by auto
    ultimately
    obtain n ns m ms where r_s_path_props: "V \<in> oldDefs g n" "g \<turnstile> n-ns\<rightarrow>defNode g r" "V \<in> oldDefs g m" "g \<turnstile> m-ms\<rightarrow>defNode g s"
      "set ns \<inter> set ms = {}" by (auto intro: ununnecessaryPhis_disjoint_paths[of g r s])

    have n_m_distinct: "n \<noteq> m"
    proof (rule ccontr)
      assume n_m: "\<not> n \<noteq> m"
      with r_s_path_props(2) old.path2_hd_in_ns
      have "n \<in> set ns" by blast
      moreover
      from n_m r_s_path_props(4) old.path2_hd_in_ns
      have "n \<in> set ms" by blast
      ultimately
      show False using r_s_path_props(5) by auto
    qed

    txt \<open>These paths can be extended into paths reaching \pf s in our set.\<close>

    from V_props r_s_allVars r_s_path_props assign_nodes_props
    obtain rs where rs_props: "g \<turnstile> n -ns@rs\<rightarrow> defNode g \<phi>\<^sub>r" "set (butlast (ns@rs)) \<inter> set ms = {}"
    using phiArg_disjoint_paths_extend by blast

    txt \<open>(In fact, we can prove that @{prop "set (ns@rs) \<inter> set ms = {}"}, which we need for the next path extension.)\<close>
    have "defNode g \<phi>\<^sub>r \<notin> set ms"
    proof (rule ccontr)
      assume \<phi>\<^sub>r_in_ms: "\<not> defNode g \<phi>\<^sub>r \<notin> set ms"
      from this r_s_path_props(4)
      obtain ms' where ms'_props: "g \<turnstile> m -ms'\<rightarrow> defNode g \<phi>\<^sub>r" "prefix ms' ms" by -(rule old.path2_prefix_ex[of g m ms "defNode g s" "defNode g \<phi>\<^sub>r"], auto)

      have "old.pathsConverge g n (ns@rs) m ms' (defNode g \<phi>\<^sub>r)"
      proof (rule old.pathsConvergeI)
        show "set (butlast (ns @ rs)) \<inter> set (butlast ms') = {}"
        proof (rule ccontr)
          assume "set (butlast (ns @ rs)) \<inter> set (butlast ms') \<noteq> {}"
          then obtain c where c_props: "c \<in> set (butlast (ns@rs))" "c \<in> set (butlast ms')" by auto
          from this(2) ms'_props(2)
          have "c \<in> set ms" by (simp add: in_prefix in_set_butlastD)
          with c_props(1) rs_props(2)
          show False by auto
        qed
      next
        have m_n_\<phi>\<^sub>r_differ: "n \<noteq> defNode g \<phi>\<^sub>r" "m \<noteq> defNode g \<phi>\<^sub>r"
          using assign_nodes_props(2,3,4,5) V_props r_s_path_props \<phi>\<^sub>r_in_ms
          apply fastforce
         using V_props(1) \<phi>\<^sub>r_in_ms assign_nodes_props(8) old.path2_in_\<alpha>n phiArg_def phiArg_same_var r_s_path_props(3,4) simpleDefs_phiDefs_var_disjoint
         by auto
        with ms'_props(1)
        show "1 < length ms'" using old.path2_nontriv by simp
        from m_n_\<phi>\<^sub>r_differ rs_props(1)
        show "1 < length (ns@rs)" using old.path2_nontriv by blast
      qed (auto intro: rs_props set_mono_prefix ms'_props)
      with V_props r_s_path_props
      have "necessaryPhi' g \<phi>\<^sub>r" unfolding necessaryPhi_def using assign_nodes_props(8) phiArg_same_var by auto
      with reachable_props(2)[OF assign_nodes_props(2)]
      show False unfolding unnecessaryPhi_def by simp
    qed

    with rs_props
    have aux: "set ms \<inter> set (ns @ rs) = {}"
      by (metis disjoint_iff_not_equal not_in_butlast old.path2_last)

    have \<phi>\<^sub>r_V: "var g \<phi>\<^sub>r = V"
      using V_props(1) assign_nodes_props(8) phiArg_same_var by auto

    have \<phi>\<^sub>r_allVars: "\<phi>\<^sub>r \<in> allVars g"
      by (meson phiArg_def assign_nodes_props(8) allDefs_in_allVars old.path2_tl_in_\<alpha>n phiDefs_in_allDefs phi_phiDefs rs_props)

    from V_props(2) \<phi>\<^sub>r_V r_s_allVars(2) \<phi>\<^sub>r_allVars r_s_path_props(3) r_s_path_props(1)
             r_s_path_props(4) rs_props(1) aux assign_nodes_props(9)
    obtain ss where ss_props: "g \<turnstile> m -ms@ss\<rightarrow> defNode g \<phi>\<^sub>s" "set (butlast (ms@ss)) \<inter> set (butlast (ns@rs)) = {}"
     by (rule phiArg_disjoint_paths_extend) (metis disjoint_iff_not_equal in_set_butlastD)

    define p\<^sub>m where "p\<^sub>m = ms@ss"
    define p\<^sub>n where "p\<^sub>n = ns@rs"

    have ind_props: "g \<turnstile> m -p\<^sub>m\<rightarrow> defNode g \<phi>\<^sub>s" "g \<turnstile> n -p\<^sub>n\<rightarrow> defNode g \<phi>\<^sub>r" "set (butlast p\<^sub>m) \<inter> set (butlast p\<^sub>n) = {}"
    using rs_props(1) ss_props p\<^sub>m_def p\<^sub>n_def by auto

    txt \<open>The following case will occur twice in the induction, with swapped identifiers, so we're proving it outside.
    Basically, if the paths @{term p\<^sub>m} and @{term p\<^sub>n} intersect, the first such intersection point must be a \pf\ in @{term "reachable g \<phi>"},
    yielding the path convergence we seek.\<close>

    have path_crossing_yields_convergence:
      "\<exists>\<phi>\<^sub>z \<in> reachable g \<phi>. \<exists>ns ms. old.pathsConverge g n ns m ms (defNode g \<phi>\<^sub>z)"
      if "\<phi>\<^sub>r \<in> reachable g \<phi>" and "\<phi>\<^sub>s \<in> reachable g \<phi>" and "g \<turnstile> n -p\<^sub>n\<rightarrow> defNode g \<phi>\<^sub>r"
        and "g \<turnstile> m -p\<^sub>m\<rightarrow> defNode g \<phi>\<^sub>s" and "set (butlast p\<^sub>m) \<inter> set (butlast p\<^sub>n) = {}"
        and "set p\<^sub>m \<inter> set p\<^sub>n \<noteq> {}"
      for \<phi>\<^sub>r \<phi>\<^sub>s p\<^sub>m p\<^sub>n
    proof -
      from that(6) split_list_first_propE
      obtain p\<^sub>m1 n\<^sub>z p\<^sub>m2 where n\<^sub>z_props: "n\<^sub>z \<in> set p\<^sub>n" "p\<^sub>m = p\<^sub>m1 @ n\<^sub>z # p\<^sub>m2" "\<forall>n \<in> set p\<^sub>m1. n \<notin> set p\<^sub>n"
         by (auto intro: split_list_first_propE)

      with that(3,4)
      obtain p\<^sub>n' where p\<^sub>n'_props: "g \<turnstile> n-p\<^sub>n'\<rightarrow>n\<^sub>z" "g \<turnstile> m-p\<^sub>m1@[n\<^sub>z]\<rightarrow>n\<^sub>z" "prefix p\<^sub>n' p\<^sub>n" "n\<^sub>z \<notin> set (butlast p\<^sub>n')"
          by (meson old.path2_prefix_ex old.path2_split(1))

      from V_props(3) reachable_same_var[OF that(1)] reachable_same_var[OF that(2)]
      have phis_V: "var g \<phi>\<^sub>r = V" "var g \<phi>\<^sub>s = V" by simp_all
      from reachable_props(1) that(1,2) \<phi>_props(2) phiArg_in_allVars
      have phis_allVars: "\<phi>\<^sub>r \<in> allVars g" "\<phi>\<^sub>s \<in> allVars g" by (metis rtranclp.cases)+

      txt \<open>Various inequalities for proving paths aren't trivial.\<close>
      have "n \<noteq> defNode g \<phi>\<^sub>r" "m \<noteq> defNode g \<phi>\<^sub>r"
       using \<phi>_node_no_defs phis_V(1) phis_allVars(1) r_s_path_props(1,3) reachable_props(2) that(1) by blast+

      from \<phi>_node_no_defs reachable_props(2) that(2) r_s_path_props(1,3) phis_V(2) that phis_allVars
      have "m \<noteq> defNode g \<phi>\<^sub>s" "n \<noteq> defNode g \<phi>\<^sub>s" by blast+

      txt \<open>With this scenario, since @{prop "set (butlast p\<^sub>n) \<inter> set (butlast p\<^sub>m) = {}"}, one of the paths @{term p\<^sub>n} and
      @{term p\<^sub>m} must end somewhere within the other, however this means the \pf\ in that node must either be @{term \<phi>} or @{term \<phi>\<^sub>r}\<close>

      from assms n\<^sub>z_props
      consider (p\<^sub>n_ends_in_p\<^sub>m) "n\<^sub>z = defNode g \<phi>\<^sub>s" | (p\<^sub>m_ends_in_p\<^sub>n) "n\<^sub>z = defNode g \<phi>\<^sub>r"
      proof (cases "n\<^sub>z = last p\<^sub>n")
        case True
        with \<open>g \<turnstile> n -p\<^sub>n\<rightarrow> defNode g \<phi>\<^sub>r\<close>
        have "n\<^sub>z = defNode g \<phi>\<^sub>r" using old.path2_last by auto
        with that(2) show ?thesis.
      next
        case False
        from n\<^sub>z_props(2)
        have "n\<^sub>z \<in> set p\<^sub>m" by simp
        with False n\<^sub>z_props(1) \<open>set (butlast p\<^sub>m) \<inter> set (butlast p\<^sub>n) = {}\<close> \<open>g \<turnstile> m -p\<^sub>m\<rightarrow> defNode g \<phi>\<^sub>s\<close>
        have "n\<^sub>z = defNode g \<phi>\<^sub>s" by (metis disjoint_elem not_in_butlast old.path2_last)
        with that(1) show ?thesis.
      qed

      thus "\<exists>\<phi>\<^sub>z \<in> reachable g \<phi>. \<exists>ns ms. old.pathsConverge g n ns m ms (defNode g \<phi>\<^sub>z)"
      proof (cases)
        case p\<^sub>n_ends_in_p\<^sub>m
        have "old.pathsConverge g n p\<^sub>n' m p\<^sub>m (defNode g \<phi>\<^sub>s)"
        proof (rule old.pathsConvergeI)
          from p\<^sub>n_ends_in_p\<^sub>m p\<^sub>n'_props(1) show "g \<turnstile> n-p\<^sub>n'\<rightarrow>defNode g \<phi>\<^sub>s" by simp
          from \<open>n \<noteq> defNode g \<phi>\<^sub>s\<close> p\<^sub>n_ends_in_p\<^sub>m p\<^sub>n'_props(1) old.path2_nontriv show "1 < length p\<^sub>n'" by auto
          from that(4) show "g \<turnstile> m -p\<^sub>m\<rightarrow> defNode g \<phi>\<^sub>s".
          with \<open>m \<noteq> defNode g \<phi>\<^sub>s\<close> old.path2_nontriv show "1 < length p\<^sub>m" by simp
          from that p\<^sub>n'_props(3) show "set (butlast p\<^sub>n') \<inter> set (butlast p\<^sub>m) = {}"
           by (meson butlast_prefix disjointI disjoint_elem in_prefix)
        qed
        with that(1,2,3) show ?thesis by (auto intro:reachable.intros(2))
      next
        case p\<^sub>m_ends_in_p\<^sub>n
        have "old.pathsConverge g n p\<^sub>n' m (p\<^sub>m1@[n\<^sub>z]) (defNode g \<phi>\<^sub>r)"
        proof (rule old.pathsConvergeI)
          from p\<^sub>m_ends_in_p\<^sub>n  p\<^sub>n'_props(1,2) show "g \<turnstile> n-p\<^sub>n'\<rightarrow>defNode g \<phi>\<^sub>r" "g \<turnstile> m-p\<^sub>m1 @ [n\<^sub>z]\<rightarrow>defNode g \<phi>\<^sub>r" by simp_all
          with \<open>n \<noteq> defNode g \<phi>\<^sub>r\<close> \<open>m \<noteq> defNode g \<phi>\<^sub>r\<close> show "1 < length p\<^sub>n'" "1 < length (p\<^sub>m1 @ [n\<^sub>z])"
           using old.path2_nontriv[of g m "p\<^sub>m1 @ [n\<^sub>z]"] old.path2_nontriv[of g n] by simp_all
          from n\<^sub>z_props p\<^sub>n'_props(3) show "set (butlast p\<^sub>n') \<inter> set (butlast (p\<^sub>m1 @ [n\<^sub>z])) = {}"
           using butlast_snoc disjointI in_prefix in_set_butlastD by fastforce
        qed
        with that(1) show ?thesis by (auto intro:reachable.intros)
      qed
    qed

    txt \<open>Since the reachable-set was built starting at a single $\phi$, these paths must at some
         point converge \emph{within} @{term "reachable g \<phi>"}.\<close>
    from assign_nodes_props(3,2) ind_props V_props(3) \<phi>\<^sub>r_V \<phi>\<^sub>r_allVars
    have "\<exists>\<phi>\<^sub>z \<in> reachable g \<phi>. \<exists>ns ms. old.pathsConverge g n ns m ms (defNode g \<phi>\<^sub>z)"
    proof (induction arbitrary: p\<^sub>m p\<^sub>n rule: reachable.induct)
      case refl
      txt \<open>In the induction basis, we know that @{prop "\<phi> = \<phi>\<^sub>s"}, and a path to @{term \<phi>\<^sub>r} must be obtained
          -- for this we need a second induction.\<close>
      from refl.prems refl.hyps show ?case
      proof (induction arbitrary: p\<^sub>m p\<^sub>n rule: reachable.induct)
        case refl
        txt \<open>The first case, in which \<open>\<phi>\<^sub>r = \<phi>\<^sub>s = \<phi>\<close>, is trivial -- \<open>\<phi>\<close> suffices.\<close>
        have "old.pathsConverge g n p\<^sub>n m p\<^sub>m (defNode g \<phi>)"
        proof (rule old.pathsConvergeI)
          show "1 < length p\<^sub>n" "1 < length p\<^sub>m"
            using refl V_props simpleDefs_phiDefs_var_disjoint unfolding unnecessaryPhi_def
            by (metis domD domIff old.path2_hd_in_\<alpha>n old.path2_nontriv phi_phiDefs r_s_path_props(1) r_s_path_props(3))+
          show "g \<turnstile> n-p\<^sub>n\<rightarrow>defNode g \<phi>" "g \<turnstile> m-p\<^sub>m\<rightarrow>defNode g \<phi>" "set (butlast p\<^sub>n) \<inter> set (butlast p\<^sub>m) = {}"
          using refl by auto
        qed
        with \<open>\<phi> \<in> reachable g \<phi>\<close> show ?case by auto
      next
        case (step \<phi>' \<phi>\<^sub>r)
        txt \<open>In this case we have that @{prop "\<phi> = \<phi>\<^sub>s"} and need to acquire a path going to @{term \<phi>\<^sub>r},
            however with the aux.\ lemma we have, we still need that @{term p\<^sub>n} and @{term p\<^sub>m} are disjoint.\<close>
        thus ?case
        proof (cases "set p\<^sub>n \<inter> set p\<^sub>m = {}")
          case paths_cross: False
          with step reachable.intros
          show ?thesis using path_crossing_yields_convergence[of \<phi>\<^sub>r \<phi> p\<^sub>n p\<^sub>m] by (metis disjointI disjoint_elem)
        next
          case True
          txt \<open>If the paths are intersection-free, we can apply our path extension lemma to obtain the path needed.\<close>
          from step(9,8,10) \<open>\<phi> \<in> allVars g\<close> r_s_path_props(1,3) step(6,5) True step(2)
          obtain ns where "g \<turnstile> n -p\<^sub>n@ns\<rightarrow> defNode g \<phi>'" "set (butlast (p\<^sub>n@ns)) \<inter> set p\<^sub>m = {}" by (rule phiArg_disjoint_paths_extend)

          from this(2) have "set (butlast p\<^sub>m) \<inter> set (butlast (p\<^sub>n @ ns)) = {}"
            using in_set_butlastD by fastforce
          moreover
          from phiArg_same_var step.hyps(2) step.prems(5) have "var g \<phi>' = V"
            by auto
          moreover
          have "\<phi>' \<in> allVars g"
            by (metis \<phi>_props(2) phiArg_in_allVars reachable.cases step.hyps(1))
          ultimately
          show "\<exists>\<phi>\<^sub>z\<in>reachable g \<phi>. \<exists>ns ms. old.pathsConverge g n ns m ms (defNode g \<phi>\<^sub>z)"
            using step.prems(1) \<phi>_props V_props \<open>g \<turnstile> n -p\<^sub>n@ns\<rightarrow> defNode g \<phi>'\<close>
            by -(rule step.IH; blast)
        qed
      qed
    next
      case (step \<phi>' \<phi>\<^sub>s)
      txt \<open>With the induction basis handled, we can finally move on to the induction proper.\<close>

      show ?thesis
      proof (cases "set p\<^sub>m \<inter> set p\<^sub>n = {}")
        case True
        have \<phi>\<^sub>s_V: "var g \<phi>\<^sub>s = V" using step(1,2,3,9) reachable_same_var by (simp add: phiArg_same_var)
        from step(2) have \<phi>\<^sub>s_allVars: "\<phi>\<^sub>s \<in> allVars g" by (rule phiArg_in_allVars)

        obtain p\<^sub>m' where tmp: "g \<turnstile> m -p\<^sub>m@p\<^sub>m'\<rightarrow> defNode g \<phi>'" "set (butlast (p\<^sub>m@p\<^sub>m')) \<inter> set (butlast p\<^sub>n) = {}"
         by (rule phiArg_disjoint_paths_extend[of g \<phi>\<^sub>s V  \<phi>\<^sub>r m n p\<^sub>m p\<^sub>n \<phi>'])
            (metis \<phi>\<^sub>s_V \<phi>\<^sub>s_allVars step r_s_path_props(1,3) True disjoint_iff_not_equal in_set_butlastD)+

        from step(5) this(1) step(7) this(2) step(9) step(10) step(11)
        show ?thesis by (rule step.IH[of "p\<^sub>m@p\<^sub>m'" p\<^sub>n])
      next
        case paths_cross: False
        with step reachable.intros
        show ?thesis using path_crossing_yields_convergence[of \<phi>\<^sub>r \<phi>\<^sub>s p\<^sub>n p\<^sub>m] by blast
      qed
    qed

    then obtain \<phi>\<^sub>z ns ms where "\<phi>\<^sub>z \<in> reachable g \<phi>" and "old.pathsConverge g n ns m ms (defNode g \<phi>\<^sub>z)"
      by blast
    moreover
    with reachable_props have "var g \<phi>\<^sub>z = V" by (metis V_props(3) phiArg_trancl_same_var rtranclpD)
    ultimately have "necessaryPhi' g \<phi>\<^sub>z " using r_s_path_props
      unfolding necessaryPhi_def by blast
    moreover with \<open>\<phi>\<^sub>z \<in> reachable g \<phi>\<close> have "unnecessaryPhi g \<phi>\<^sub>z" by -(rule reachable_props)
    ultimately show False unfolding unnecessaryPhi_def by blast
  qed
qed

txt \<open>Together with lemma 1, we thus have that a CFG without redundant SCCs is cytron-minimal, proving that the
     property established by Braun et al.'s algorithm suffices.\<close>
corollary no_redundant_SCC_minimal:
assumes "\<not>(\<exists>P scc. redundant_scc g P scc)"
shows "cytronMinimal g"
using assms 1 no_redundant_set_minimal by blast

txt \<open>Finally, to conclude, we'll show that the above theorem is indeed a stronger assertion about a graph
     than the lack of trivial \pf s. Intuitively, this is because a set containing only a
     trivial \pf\ is a redundant set.\<close>

corollary
assumes "\<not>(\<exists>P. redundant_set g P)"
shows "\<not>redundant g"
proof -
  have "redundant g \<Longrightarrow> \<exists>P. redundant_set g P"
  proof -
    assume "redundant g"
    then obtain \<phi> where "phi g \<phi> \<noteq> None" "trivial g \<phi>"
     unfolding redundant_def redundant_set_def dom_def phiArg_def trivial_def isTrivialPhi_def
     by (clarsimp split: option.splits) fastforce
    hence "redundant_set g {\<phi>}"
     unfolding redundant_set_def dom_def phiArg_def trivial_def isTrivialPhi_def
     by auto
    thus ?thesis by auto
  qed
  with assms show ?thesis by auto
qed

end

end