(*
  File:      HOL/Number_Theory/Residue_Primitive_Roots.thy
  Author:    Manuel Eberl

  Primitive roots in residue rings: Definition and existence criteria
*)
section \<open>Primitive roots in residue rings and Carmichael's function\<close>
theory Residue_Primitive_Roots
  imports Pocklington
begin

text \<open>
  This theory develops the notions of primitive roots (generators) in residue rings. It also
  provides a definition and all the basic properties of Carmichael's function $\lambda(n)$, which
  is strongly related to this. The proofs mostly follow Apostol's presentation
\<close>

subsection \<open>Primitive roots in residue rings\<close>

text \<open>
  A primitive root of a residue ring modulo \<open>n\<close> is an element \<open>g\<close> that \<^emph>\<open>generates\<close> the
  ring, i.\,e.\ such that for each \<open>x\<close> coprime to \<open>n\<close> there exists an \<open>i\<close> such that $x = g^i$.
  A simpler definition is that \<open>g\<close> must have the same order as the cardinality of the
  multiplicative group, which is $\varphi(n)$.

  Note that for convenience, this definition does \<^emph>\<open>not\<close> demand \<open>g < n\<close>.
\<close>
inductive residue_primroot :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
  "n > 0 \<Longrightarrow> coprime n g \<Longrightarrow> ord n g = totient n \<Longrightarrow> residue_primroot n g"

lemma residue_primroot_def [code]:
  "residue_primroot n x \<longleftrightarrow> n > 0 \<and> coprime n x \<and> ord n x = totient n"
  by (simp add: residue_primroot.simps)

lemma not_residue_primroot_0 [simp]: "~residue_primroot 0 x"
  by (auto simp: residue_primroot_def)

lemma residue_primroot_mod [simp]: "residue_primroot n (x mod n) = residue_primroot n x"
  by (cases "n = 0") (simp_all add: residue_primroot_def)

lemma residue_primroot_cong:
  assumes "[x = x'] (mod n)"
  shows   "residue_primroot n x = residue_primroot n x'"
proof -
  have "residue_primroot n x = residue_primroot n (x mod n)"
    by simp
  also have "x mod n = x' mod n"
    using assms by (simp add: cong_def)
  also have "residue_primroot n (x' mod n) = residue_primroot n x'"
    by simp
  finally show ?thesis .
qed

lemma not_residue_primroot_0_right [simp]: "residue_primroot n 0 \<longleftrightarrow> n = 1"
  by (auto simp: residue_primroot_def)

lemma residue_primroot_1_iff: "residue_primroot n (Suc 0) \<longleftrightarrow> n \<in> {1, 2}"
proof
  assume *: "residue_primroot n (Suc 0)"
  with totient_gt_1[of n] have "n \<le> 2" by (cases "n \<le> 2") (auto simp: residue_primroot_def)
  hence "n \<in> {0, 1, 2}" by auto
  thus "n \<in> {1, 2}" using * by (auto simp: residue_primroot_def)
qed (auto simp: residue_primroot_def)

subsection \<open>Primitive roots modulo a prime\<close>

text \<open>
  For prime \<open>p\<close>, we now analyse the number of elements in the ring $\mathbb{Z}/p\mathbb{Z}$
  whose order is precisely \<open>d\<close> for each \<open>d\<close>.
\<close>
context
  fixes n :: nat and \<psi>
  assumes n: "n > 1"
  defines "\<psi> \<equiv> (\<lambda>d. card {x\<in>totatives n. ord n x = d})"
begin

lemma elements_with_ord_restrict_totatives:
  "d > 0 \<Longrightarrow> {x\<in>{..<n}. ord n x = d} = {x\<in>totatives n. ord n x = d}"
  using n by (auto simp: totatives_def coprime_commute intro!: Nat.gr0I le_neq_trans)

lemma prime_elements_with_ord:
  assumes "\<psi> d \<noteq> 0" and "prime n"
      and a: "a \<in> totatives n" "ord n a = d" "a \<noteq> 1"
  shows   "inj_on (\<lambda>k. a ^ k mod n) {..<d}"
    and   "{x\<in>{..<n}. [x ^ d = 1] (mod n)} = (\<lambda>k. a ^ k mod n) ` {..<d}"
    and   "bij_betw (\<lambda>k. a ^ k mod n) (totatives d) {x\<in>{..<n}. ord n x = d}"
proof -
  show inj: "inj_on (\<lambda>k. a ^ k mod n) {..<d}"
    using inj_power_mod[of n a] a by (auto simp: totatives_def coprime_commute)
  from a have "d > 0" by (auto simp: totatives_def coprime_commute)
  moreover have "d \<noteq> 1" using a n
    by (auto simp: ord_eq_Suc_0_iff totatives_less cong_def)
  ultimately have d: "d > 1" by simp

  have *: "(\<lambda>k. a ^ k mod n) ` {..<d} = {x\<in>{..<n}. [x ^ d = 1] (mod n)}"
  proof (rule card_seteq)
    have "card {x\<in>{..<n}. [x ^ d = 1] (mod n)} \<le> d"
      using assms a by (intro roots_mod_prime_bound) (auto simp: totatives_def coprime_commute)
    also have "\<dots> = card ((\<lambda>k. a ^ k mod n) ` {..<d})"
      using inj by (subst card_image) auto
    finally show "card {x \<in> {..<n}. [x ^ d = 1] (mod n)} \<le> \<dots>" .
  next
    show "(\<lambda>k. a ^ k mod n) ` {..<d} \<subseteq> {x \<in> {..<n}. [x ^ d = 1] (mod n)}"
    proof safe
      fix k assume "k < d"
      have "[(a ^ d) ^ k = 1 ^ k] (mod n)"
        by (intro cong_pow) (use a in \<open>auto simp: ord_divides'\<close>)
      thus "[(a ^ k mod n) ^ d = 1] (mod n)"
        by (simp add: power_mult [symmetric] cong_def power_mod mult.commute)
    qed (use \<open>prime n\<close> in \<open>auto dest: prime_gt_1_nat\<close>)
  qed auto
  thus "{x\<in>{..<n}. [x ^ d = 1] (mod n)} = (\<lambda>k. a ^ k mod n) ` {..<d}" ..

  show "bij_betw (\<lambda>k. a ^ k mod n) (totatives d) {x\<in>{..<n}. ord n x = d}"
    unfolding bij_betw_def
  proof (intro conjI inj_on_subset[OF inj] equalityI subsetI)
    fix b assume "b \<in> (\<lambda>k. a ^ k mod n) ` totatives d"
    then obtain k where "b = a ^ k mod n" "k \<in> totatives d" by auto
    thus "b \<in> {b \<in> {..<n}. ord n b = d}"
      using n a by (simp add: ord_power totatives_def coprime_commute)
  next
    fix b assume "b \<in> {x \<in> {..<n}. ord n x = d}"
    hence b: "ord n b = d" "b < n" by auto
    with d have "coprime n b" using ord_eq_0[of n b] by auto
    from b have "b \<in> {x\<in>{..<n}. [x ^ d = 1] (mod n)}"
      by (auto simp: ord_divides')
    with * obtain k where k: "k < d" "b = a ^ k mod n"
      by blast
    with b(2) n a d have "d div gcd k d = ord n b"
      using \<open>coprime n b\<close> by (auto simp: ord_power)
    also have "ord n b = d" by (simp add: b)
    finally have "coprime k d"
      unfolding coprime_iff_gcd_eq_1 using d a by (subst (asm) div_eq_dividend_iff) auto
    with k b d have "k \<in> totatives d" by (auto simp: totatives_def intro!: Nat.gr0I)
    with k show "b \<in> (\<lambda>k. a ^ k mod n) ` totatives d" by blast
  qed (use d n in \<open>auto simp: totatives_less\<close>)
qed

lemma prime_card_elements_with_ord:
  assumes "\<psi> d \<noteq> 0" and "prime n"
  shows   "\<psi> d = totient d"
proof (cases "d = 1")
  case True
  have "\<psi> 1 = 1"
    using elements_with_ord_1[of n] n by (simp add: \<psi>_def)
  thus ?thesis using True by simp
next
  case False
  from assms obtain a where a: "a \<in> totatives n" "ord n a = d"
    by (auto simp: \<psi>_def)
  from a have "d > 0" by (auto intro!: Nat.gr0I simp: ord_eq_0 totatives_def coprime_commute)
  from a and False have "a \<noteq> 1" by auto
  from bij_betw_same_card[OF prime_elements_with_ord(3)[OF assms a this]] show "\<psi> d = totient d"
    using elements_with_ord_restrict_totatives[of d] False a \<open>d > 0\<close>
    by (simp add: \<psi>_def totient_def)
qed

lemma prime_sum_card_elements_with_ord_eq_totient:
  "(\<Sum>d | d dvd totient n. \<psi> d) = totient n"
proof -
  have "totient n = card (totatives n)"
    by (simp add: totient_def)
  also have "totatives n = (\<Union>d\<in>{d. d dvd totient n}. {x\<in>totatives n. ord n x = d})"
    by (force simp: order_divides_totient totatives_def coprime_commute)
  also have "card \<dots> = (\<Sum>d | d dvd totient n. \<psi> d)"
    unfolding \<psi>_def using n by (subst card_UN_disjoint) (auto intro!: finite_divisors_nat)
  finally show ?thesis ..
qed

text \<open>
  We can now show that the number of elements of order \<open>d\<close> is $\varphi(d)$ if $d\mid p - 1$
  and 0 otherwise.
\<close>
theorem prime_card_elements_with_ord_eq_totient:
  assumes "prime n"
  shows   "\<psi> d = (if d dvd n - 1 then totient d else 0)"
proof (cases "d dvd totient n")
  case False
  thus ?thesis using order_divides_totient[of n] assms
    by (auto simp: \<psi>_def totient_prime totatives_def coprime_commute[of n])
next
  case True
  have "\<psi> d = totient d"
  proof (rule ccontr)
    assume neq: "\<psi> d \<noteq> totient d"
    have le: "\<psi> d \<le> totient d" if "d dvd totient n" for d
      using prime_card_elements_with_ord[of d] assms by (cases "\<psi> d = 0") auto
    from neq and le[of d] and True have less: "\<psi> d < totient d" by auto

    have "totient n = (\<Sum>d | d dvd totient n. \<psi> d)"
      using prime_sum_card_elements_with_ord_eq_totient ..
    also have "\<dots> < (\<Sum>d | d dvd totient n. totient d)"
      by (rule sum_strict_mono_ex1)
         (use n le less assms True in \<open>auto intro!: finite_divisors_nat\<close>)
    also have "\<dots> = totient n"
      using totient_divisor_sum .
    finally show False by simp
  qed
  with True show ?thesis using assms by (simp add: totient_prime)
qed

text \<open>
  As a corollary, we get that the number of primitive roots modulo a prime \<open>p\<close> is
  $\varphi(p - 1)$. Since this number is positive, we also get that there \<^emph>\<open>is\<close> at least
  one primitive root modulo \<open>p\<close>.
\<close>
lemma
  assumes "prime n"
  shows   prime_card_primitive_roots:  "card {x\<in>totatives n. ord n x = n - 1} = totient (n - 1)"
                                       "card {x\<in>{..<n}. ord n x = n - 1} = totient (n - 1)"
  and     prime_primitive_root_exists: "\<exists>x. residue_primroot n x"
proof -
  show *: "card {x\<in>totatives n. ord n x = n - 1} = totient (n - 1)"
    using prime_card_elements_with_ord_eq_totient[of "n - 1"] assms
    by (auto simp: totient_prime \<psi>_def)
  thus "card {x\<in>{..<n}. ord n x = n - 1} = totient (n - 1)"
    using assms n elements_with_ord_restrict_totatives[of "n - 1"] by simp

  note *
  also have "totient (n - 1) > 0" using n by auto
  finally show "\<exists>x. residue_primroot n x" using assms prime_gt_1_nat[of n]
    by (subst (asm) card_gt_0_iff)
       (auto simp: residue_primroot_def totient_prime totatives_def coprime_commute)
qed

end

subsection \<open>Primitive roots modulo powers of an odd prime\<close>

text \<open>
  Any primitive root \<open>g\<close> modulo an odd prime \<open>p\<close> is also a primitive root modulo $p^k$ for all
  $k > 0$ if $[g^{p - 1} \neq 1]\ (\text{mod}\ p^2)$. To show this, we first need the
  following lemma.
\<close>
lemma residue_primroot_power_prime_power_neq_1:
  assumes "k \<ge> 2"
  assumes p: "prime p" "odd p" and "residue_primroot p g" and "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
  shows   "[g ^ totient (p ^ (k - 1)) \<noteq> 1] (mod (p ^ k))"
  using assms(1)
proof (induction k rule: dec_induct)
  case base
  thus ?case using assms by (simp add: totient_prime)
next
  case (step k)
  from p have "p > 2"
    using prime_gt_1_nat[of p] by (cases "p = 2") auto
  from assms have g: "g > 0" by (auto intro!: Nat.gr0I)
  have "[g ^ totient (p ^ (k - 1)) = 1] (mod p ^ (k - 1))"
    using assms by (intro euler_theorem)
                   (auto simp: residue_primroot_def totatives_def coprime_commute)
  from cong_to_1_nat[OF this]
    obtain t where *: "g ^ totient (p ^ (k - 1)) - 1 = p ^ (k - 1) * t" by auto
  have t: "g ^ totient (p ^ (k - 1)) = p ^ (k - 1) * t + 1"
    using g by (subst * [symmetric]) auto

  have "\<not>p dvd t"
  proof
    assume "p dvd t"
    then obtain q where [simp]: "t = p * q" by auto
    from t have "g ^ totient (p ^ (k - 1)) = p ^ k * q + 1"
      using \<open>k \<ge> 2\<close> by (cases k) auto
    hence "[g ^ totient (p ^ (k - 1)) = p ^ k * q + 1] (mod p ^ k)"
      by simp
    also have "[p ^ k * q + 1 = 0 * q + 1] (mod p ^ k)"
      by (intro cong_add cong_mult) (auto simp: cong_0_iff)
    finally have "[g ^ totient (p ^ (k - 1)) = 1] (mod p ^ k)"
      by simp
    with step.IH show False by contradiction
  qed

  from t have "(g ^ totient (p ^ (k - 1))) ^ p = (p ^ (k - 1) * t + 1) ^ p"
    by (rule arg_cong)
  also have "(g ^ totient (p ^ (k - 1))) ^ p = g ^ (p * totient (p ^ (k - 1)))"
    by (simp add: power_mult [symmetric] mult.commute)
  also have "p * totient (p ^ (k - 1)) = totient (p ^ k)"
    using p \<open>k \<ge> 2\<close> by (simp add: totient_prime_power Suc_diff_Suc flip: power_Suc)
  also have "(p ^ (k - 1) * t + 1) ^ p = (\<Sum>i\<le>p. (p choose i) * t ^ i * p ^ (i * (k - 1)))"
    by (subst binomial) (simp_all add: mult_ac power_mult_distrib power_mult [symmetric])
  finally have "[g ^ totient (p ^ k) = (\<Sum>i\<le>p. (p choose i) * t ^ i * p ^ (i * (k - 1)))]
                  (mod (p ^ Suc k))" (is "[_ = ?rhs] (mod _)") by simp

  also have "[?rhs = (\<Sum>i\<le>p. if i \<le> 1 then (p choose i) * t ^ i * p ^ (i * (k - 1)) else 0)]
               (mod (p ^ Suc k))" (is "[sum ?f _ = sum ?g _] (mod _)")
  proof (intro cong_sum)
    fix i assume i: "i \<in> {..p}"
    consider "i \<le> 1" | "i = 2" | "i > 2" by force
    thus "[?f i = ?g i] (mod (p ^ Suc k))"
    proof cases
      assume i: "i > 2"
      have "Suc k \<le> 3 * (k - 1)"
        using \<open>k \<ge> 2\<close> by (simp add: algebra_simps)
      also have "3 * (k - 1) \<le> i * (k - 1)"
        using i by (intro mult_right_mono) auto
      finally have "p ^ Suc k dvd ?f i"
        by (intro dvd_mult le_imp_power_dvd)
      thus "[?f i = ?g i] (mod (p ^ Suc k))"
        by (simp add: cong_0_iff)
    next
      assume [simp]: "i = 2"
      have "?f i = p * (p - 1) div 2 * t\<^sup>2 * p ^ (2 * (k - 1))"
        using choose_two[of p] by simp
      also have "p * (p - 1) div 2 = (p - 1) div 2 * p"
        using \<open>odd p\<close> by (auto elim!: oddE)
      also have "\<dots> * t\<^sup>2 * p ^ (2 * (k - 1)) = (p - 1) div 2 * t\<^sup>2 * (p * p ^ (2 * (k - 1)))"
        by (simp add: algebra_simps)
      also have "p * p ^ (2 * (k - 1)) = p ^ (2 * k - 1)"
        using \<open>k \<ge> 2\<close> by (cases k) auto
      also have "p ^ Suc k dvd (p - 1) div 2 * t\<^sup>2 * p ^ (2 * k - 1)"
        using \<open>k \<ge> 2\<close> by (intro dvd_mult le_imp_power_dvd) auto
      finally show "[?f i = ?g i] (mod (p ^ Suc k))"
        by (simp add: cong_0_iff)
    qed auto
  qed
  also have "(\<Sum>i\<le>p. ?g i) = (\<Sum>i\<le>1. ?f i)"
    using p prime_gt_1_nat[of p] by (intro sum.mono_neutral_cong_right) auto
  also have "\<dots> = 1 + t * p ^ k"
    using choose_two[of p] \<open>k \<ge> 2\<close> by (cases k) simp_all
  finally have eq: "[g ^ totient (p ^ k) = 1 + t * p ^ k] (mod p ^ Suc k)" .

  have "[g ^ totient (p ^ k) \<noteq> 1] (mod p ^ Suc k)"
  proof
    assume "[g ^ totient (p ^ k) = 1] (mod p ^ Suc k)"
    hence "[g ^ totient (p ^ k) - g ^ totient (p ^ k) = 1 + t * p ^ k - 1] (mod p ^ Suc k)"
      by (intro cong_diff_nat eq) auto
    hence "[t * p ^ k = 0] (mod p ^ Suc k)"
      by (simp add: cong_sym_eq)
    hence "p * p ^ k dvd t * p ^ k"
      by (simp add: cong_0_iff)
    hence "p dvd t" using \<open>p > 2\<close> by simp
    with \<open>\<not>p dvd t\<close> show False by contradiction
  qed
  thus ?case by simp
qed

text \<open>
  We can now show that primitive roots modulo \<open>p\<close> with the above condition are
  indeed also primitive roots modulo $p^k$.
\<close>
proposition residue_primroot_prime_lift_iff:
  assumes p: "prime p" "odd p" and "residue_primroot p g"
  shows   "(\<forall>k>0. residue_primroot (p ^ k) g) \<longleftrightarrow> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
proof -
  from assms have g: "coprime p g" "ord p g = p - 1"
    by (auto simp: residue_primroot_def totient_prime)
  show ?thesis
  proof
    assume "\<forall>k>0. residue_primroot (p ^ k) g"
    hence "residue_primroot (p\<^sup>2) g" by auto
    hence "ord (p\<^sup>2) g = totient (p\<^sup>2)"
      by (simp_all add: residue_primroot_def)
    thus "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
      using g assms prime_gt_1_nat[of p]
      by (auto simp: ord_divides' totient_prime_power)
  next
    assume g': "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"

    have "residue_primroot (p ^ k) g" if "k > 0" for k
    proof (cases "k = 1")
      case False
      with that have k: "k > 1" by simp
      from g have coprime: "coprime (p ^ k) g"
        by (auto simp: totatives_def coprime_commute)

      define t where "t = ord (p ^ k) g"
      have "[g ^ t = 1] (mod (p ^ k))"
        by (simp add: t_def ord_divides')
      also have "p ^ k = p * p ^ (k - 1)"
        using k by (cases k) auto
      finally have "[g ^ t = 1] (mod p)"
        by (rule cong_modulus_mult_nat)
      hence "totient p dvd t"
        using g p by (simp add: ord_divides' totient_prime)
      then obtain q where t: "t = totient p * q" by auto

      have "t dvd totient (p ^ k)"
        using coprime by (simp add: t_def order_divides_totient)
      with t p k have "q dvd p ^ (k - 1)" using prime_gt_1_nat[of p]
        by (auto simp: totient_prime totient_prime_power)
      then obtain b where b: "b \<le> k - 1" "q = p ^ b"
        using divides_primepow_nat[of p q "k - 1"] p by auto

      have "b = k - 1"
      proof (rule ccontr)
        assume "b \<noteq> k - 1"
        with b have "b < k - 1" by simp
        have "t = p ^ b * (p - 1)"
          using b p by (simp add: t totient_prime)
        also have "\<dots> dvd p ^ (k - 2) * (p - 1)"
          using \<open>b < k - 1\<close> by (intro mult_dvd_mono le_imp_power_dvd) auto
        also have "\<dots> = totient (p ^ (k - 1))"
          using k p by (simp add: totient_prime_power numeral_2_eq_2)
        finally have "[g ^ totient (p ^ (k - 1)) = 1] (mod (p ^ k))"
          by (simp add: ord_divides' t_def)
        with residue_primroot_power_prime_power_neq_1[of k p g] p k assms g' show False
          by auto
      qed
      hence "t = totient (p ^ k)"
        using p k by (simp add: t b totient_prime totient_prime_power)
      thus "residue_primroot (p ^ k) g"
        using g one_less_power[of p k] prime_gt_1_nat[of p] p k
        by (simp add: residue_primroot_def t_def)
    qed (use assms in auto)
    thus "\<forall>k>0. residue_primroot (p ^ k) g" by blast
  qed
qed

text \<open>
  If \<open>p\<close> is an odd prime, there is always a primitive root \<open>g\<close> modulo \<open>p\<close>, and if \<open>g\<close> does not
  fulfil the above assumption required for it to be liftable to $p^k$, we can use $g + p$, which
  is also a primitive root modulo \<open>p\<close> and \<^emph>\<open>does\<close> fulfil the assumption.

  This shows that any modulus that is a power of an odd prime has a primitive root.
\<close>
theorem residue_primroot_odd_prime_power_exists:
  assumes p: "prime p" "odd p"
  obtains g where "\<forall>k>0. residue_primroot (p ^ k) g"
proof -
  obtain g where g: "residue_primroot p g"
    using prime_primitive_root_exists[of p] assms prime_gt_1_nat[of p] by auto

  have "\<exists>g. residue_primroot p g \<and> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
  proof (cases "[g ^ (p - 1) = 1] (mod p\<^sup>2)")
    case True
    define g' where "g' = p + g"
    note g
    also have "residue_primroot p g \<longleftrightarrow> residue_primroot p g'"
      unfolding g'_def by (rule residue_primroot_cong) (auto simp: cong_def)
    finally have g': "residue_primroot p g'" .

    have "[g' ^ (p - 1) = (\<Sum>k\<le>p-1. ((p-1) choose k) * g ^ (p - Suc k) * p ^ k)] (mod p\<^sup>2)"
      (is "[_ = ?rhs] (mod _)") by (simp add: g'_def binomial mult_ac)
    also have "[?rhs = (\<Sum>k\<le>p-1. if k \<le> 1 then ((p-1) choose k) *
                                   g ^ (p - Suc k) * p ^ k else 0)] (mod p\<^sup>2)"
      (is "[sum ?f _ = sum ?g _] (mod _)")
    proof (intro cong_sum)
      fix k assume "k \<in> {..p-1}"
      show "[?f k = ?g k] (mod p\<^sup>2)"
      proof (cases "k \<le> 1")
        case False
        have "p\<^sup>2 dvd ?f k"
          using False by (intro dvd_mult le_imp_power_dvd) auto
        thus ?thesis using False by (simp add: cong_0_iff)
      qed auto
    qed
    also have "sum ?g {..p-1} = sum ?f {0, 1}"
      using prime_gt_1_nat[of p] p by (intro sum.mono_neutral_cong_right) auto
    also have "\<dots> = g ^ (p - 1) + p * (p - 1) * g ^ (p - 2)"
      using p by (simp add: numeral_2_eq_2)
    also have "[g ^ (p - 1) + p * (p - 1) * g ^ (p - 2) = 1 + p * (p - 1) * g ^ (p - 2)] (mod p\<^sup>2)"
      by (intro cong_add True) auto
    finally have "[g' ^ (p - 1) = 1 + p * (p - 1) * g ^ (p - 2)] (mod p\<^sup>2)" .

    moreover have "[1 + p * (p - 1) * g ^ (p - 2) \<noteq> 1] (mod p\<^sup>2)"
    proof
      assume "[1 + p * (p - 1) * g ^ (p - 2) = 1] (mod p\<^sup>2)"
      hence "[1 + p * (p - 1) * g ^ (p - 2) - 1 = 1 - 1] (mod p\<^sup>2)"
        by (intro cong_diff_nat) auto
      hence "p * p dvd p * ((p - 1) * g ^ (p - 2))"
        by (auto simp: cong_0_iff power2_eq_square)
      hence "p dvd (p - 1) * g ^ (p - 2)"
        using p by simp
      hence "p dvd g ^ (p - 2)"
        using p dvd_imp_le[of p "p - Suc 0"] prime_gt_1_nat[of p]
        by (auto simp: prime_dvd_mult_iff)
      also have "\<dots> dvd g ^ (p - 1)"
        by (intro le_imp_power_dvd) auto
      finally have "[g ^ (p - 1) = 0] (mod p)"
        by (simp add: cong_0_iff)
      hence "[0 = g ^ (p - 1)] (mod p)"
        by (simp add: cong_sym_eq)

      also from \<open>residue_primroot p g\<close> have "[g ^ (p - 1) = 1] (mod p)"
        using p by (auto simp: residue_primroot_def ord_divides' totient_prime)
      finally have "[0 = 1] (mod p)" .
      thus False using prime_gt_1_nat[of p] p by (simp add: cong_def)
    qed

    ultimately have "[g' ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
      by (simp add: cong_def)
    thus "\<exists>g. residue_primroot p g \<and> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
      using g' by blast
  qed (use g in auto)
  thus ?thesis
    using residue_primroot_prime_lift_iff[OF assms] that by blast
qed

subsection \<open>Carmichael's function\<close>

text \<open>
  Carmichael's function $\lambda(n)$ gives the LCM of the orders of all elements in the
  residue ring modulo $n$ -- or, equivalently, the maximum order, as we will show later.
  Algebraically speaking, it is the exponent of the multiplicative group
  $(\mathbb{Z}/n\mathbb{Z})^*$.

  It is not to be confused with Liouville's function, which is also denoted by $\lambda(n)$.
\<close>
definition Carmichael where
  "Carmichael n = (LCM a \<in> totatives n. ord n a)"

lemma Carmichael_0 [simp]: "Carmichael 0 = 1"
  by (simp add: Carmichael_def)

lemma Carmichael_1 [simp]: "Carmichael 1 = 1"
  by (simp add: Carmichael_def)

lemma Carmichael_Suc_0 [simp]: "Carmichael (Suc 0) = 1"
  by (simp add: Carmichael_def)

lemma ord_dvd_Carmichael:
  assumes "n > 1" "coprime n k"
  shows   "ord n k dvd Carmichael n"
proof -
  have "k mod n \<in> totatives n"
    using assms by (auto simp: totatives_def coprime_commute intro!: Nat.gr0I)
  hence "ord n (k mod n) dvd Carmichael n"
    by (simp add: Carmichael_def del: ord_mod)
  thus ?thesis by simp
qed

lemma Carmichael_divides:
  assumes "Carmichael n dvd k" "coprime n a"
  shows   "[a ^ k = 1] (mod n)"
proof (cases "n < 2 \<or> a = 1")
  case False
  hence "ord n a dvd Carmichael n"
    using False assms by (intro ord_dvd_Carmichael) auto
  also have "\<dots> dvd k" by fact
  finally have "ord n a dvd k" .
  thus ?thesis using ord_divides by auto
next
  case True
  then consider "a = 1" | "n = 0" | "n = 1" by force
  thus ?thesis using assms by cases auto
qed

lemma Carmichael_dvd_totient: "Carmichael n dvd totient n"
  unfolding Carmichael_def
proof (intro Lcm_least, safe)
  fix a assume "a \<in> totatives n"
  hence "[a ^ totient n = 1] (mod n)"
    by (intro euler_theorem) (auto simp: totatives_def)
  thus "ord n a dvd totient n"
    using ord_divides by blast
qed

lemma Carmichael_dvd_mono_coprime:
  assumes "coprime m n" "m > 1" "n > 1"
  shows   "Carmichael m dvd Carmichael (m * n)"
  unfolding Carmichael_def[of m]
proof (intro Lcm_least, safe)
  fix x assume x: "x \<in> totatives m"
  from assms have "totatives n \<noteq> {}" by simp
  then obtain y where y: "y \<in> totatives n" by blast

  from binary_chinese_remainder_nat[OF assms(1), of x y]
  obtain z where z: "[z = x] (mod m)" "[z = y] (mod n)" by blast
  have z': "coprime z n" "coprime z m"
    by (rule cong_imp_coprime; use x y z in \<open>force simp: totatives_def cong_sym_eq\<close>)+

  from z have "ord m x = ord m z"
    by (intro ord_cong) (auto simp: cong_sym_eq)
  also have "ord m z dvd ord (m * n) z"
    using assms by (auto simp: ord_modulus_mult_coprime)
  also from z' assms have "\<dots> dvd Carmichael (m * n)"
    by (intro ord_dvd_Carmichael) (auto simp: coprime_commute intro!:one_less_mult)
  finally show "ord m x dvd Carmichael (m * n)" .
qed

text \<open>
  $\lambda$ distributes over the product of coprime numbers similarly to $\varphi$, but
  with LCM instead of multiplication:
\<close>
lemma Carmichael_mult_coprime:
  assumes "coprime m n"
  shows   "Carmichael (m * n) = lcm (Carmichael m) (Carmichael n)"
proof (cases "m \<le> 1 \<or> n \<le> 1")
  case True
  hence "m = 0 \<or> n = 0 \<or> m = 1 \<or> n = 1" by force
  thus ?thesis using assms by auto
next
  case False
  show ?thesis
  proof (rule dvd_antisym)
    show "Carmichael (m * n) dvd lcm (Carmichael m) (Carmichael n)"
      unfolding Carmichael_def[of "m * n"]
    proof (intro Lcm_least, safe)
      fix x assume x: "x \<in> totatives (m * n)"
      have "ord (m * n) x = lcm (ord m x) (ord n x)"
        using assms x by (subst ord_modulus_mult_coprime) (auto simp: coprime_commute totatives_def)
      also have "\<dots> dvd lcm (Carmichael m) (Carmichael n)"
        using False x
        by (intro lcm_mono ord_dvd_Carmichael) (auto simp: totatives_def coprime_commute)
      finally show "ord (m * n) x dvd \<dots>" .
    qed
  next
    show "lcm (Carmichael m) (Carmichael n) dvd Carmichael (m * n)"
      using Carmichael_dvd_mono_coprime[of m n]
            Carmichael_dvd_mono_coprime[of n m] assms False
      by (auto intro!: lcm_least simp: coprime_commute mult.commute)
  qed
qed

lemma Carmichael_pos [simp, intro]: "Carmichael n > 0"
  by (auto simp: Carmichael_def ord_eq_0 totatives_def coprime_commute intro!: Nat.gr0I)

lemma Carmichael_nonzero [simp]: "Carmichael n \<noteq> 0"
  by simp

lemma power_Carmichael_eq_1:
  assumes "n > 1" "coprime n x"
  shows   "[x ^ Carmichael n = 1] (mod n)"
  using ord_dvd_Carmichael[of n x] assms
  by (auto simp: ord_divides')

lemma Carmichael_2 [simp]: "Carmichael 2 = 1"
  using Carmichael_dvd_totient[of 2] by simp

lemma Carmichael_4 [simp]: "Carmichael 4 = 2"
proof -
  have "Carmichael 4 dvd 2"
    using Carmichael_dvd_totient[of 4] by simp
  hence "Carmichael 4 \<le> 2" by (rule dvd_imp_le) auto
  moreover have "Carmichael 4 \<noteq> 1"
    using power_Carmichael_eq_1[of "4::nat" 3]
    unfolding coprime_iff_gcd_eq_1 by (auto simp: gcd_non_0_nat cong_def)
  ultimately show ?thesis
    using Carmichael_pos[of 4] by linarith
qed

lemma residue_primroot_Carmichael:
  assumes "residue_primroot n g"
  shows   "Carmichael n = totient n"
proof (cases "n = 1")
  case False
  show ?thesis
  proof (intro dvd_antisym Carmichael_dvd_totient)
    have "ord n g dvd Carmichael n"
      using assms False by (intro ord_dvd_Carmichael) (auto simp: residue_primroot_def)
    thus "totient n dvd Carmichael n"
      using assms by (auto simp: residue_primroot_def)
  qed
qed auto

lemma Carmichael_odd_prime_power:
  assumes "prime p" "odd p" "k > 0"
  shows   "Carmichael (p ^ k) = p ^ (k - 1) * (p - 1)"
proof -
  from assms obtain g where "residue_primroot (p ^ k) g"
    using residue_primroot_odd_prime_power_exists[of p] assms by metis
  hence "Carmichael (p ^ k) = totient (p ^ k)"
    by (intro residue_primroot_Carmichael[of "p ^ k" g]) auto
  with assms show ?thesis by (simp add: totient_prime_power)
qed

lemma Carmichael_prime:
  assumes "prime p"
  shows   "Carmichael p = p - 1"
proof (cases "even p")
  case True
  with assms have "p = 2"
    using primes_dvd_imp_eq two_is_prime_nat by blast
  thus ?thesis by simp
next
  case False
  with Carmichael_odd_prime_power[of p 1] assms show ?thesis by simp
qed

lemma Carmichael_twopow_ge_8:
  assumes "k \<ge> 3"
  shows   "Carmichael (2 ^ k) = 2 ^ (k - 2)"
proof (intro dvd_antisym)
  have "2 ^ (k - 2) = ord (2 ^ k) (3 :: nat)"
    using ord_twopow_3_5[of k 3] assms by simp
  also have "\<dots> dvd Carmichael (2 ^ k)"
    using assms one_less_power[of "2::nat" k] by (intro ord_dvd_Carmichael) auto
  finally show "2 ^ (k - 2) dvd \<dots>" .
next
  show "Carmichael (2 ^ k) dvd 2 ^ (k - 2)"
    unfolding Carmichael_def
  proof (intro Lcm_least, safe)
    fix x assume "x \<in> totatives (2 ^ k)"
    hence "odd x" by (auto simp: totatives_def)
    hence "[x ^ 2 ^ (k - 2) = 1] (mod 2 ^ k)"
      using assms ord_twopow_aux[of k x] by auto
    thus "ord (2 ^ k) x dvd 2 ^ (k - 2)"
      by (simp add: ord_divides')
  qed
qed

lemma Carmichael_twopow:
  "Carmichael (2 ^ k) = (if k \<le> 2 then 2 ^ (k - 1) else 2 ^ (k - 2))"
proof -
  have "k = 0 \<or> k = 1 \<or> k = 2 \<or> k \<ge> 3" by linarith
  thus ?thesis by (auto simp: Carmichael_twopow_ge_8)
qed

lemma Carmichael_prime_power:
  assumes "prime p" "k > 0"
  shows   "Carmichael (p ^ k) =
             (if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
proof (cases "p = 2")
  case True
  thus ?thesis by (simp add: Carmichael_twopow)
next
  case False
  with assms have "odd p" "p > 2"
    using prime_odd_nat[of p] prime_gt_1_nat[of p] by auto
  thus ?thesis
    using assms Carmichael_odd_prime_power[of p k] by simp
qed

lemma Carmichael_prod_coprime:
  assumes "finite A" "\<And>i j. i \<in> A \<Longrightarrow> j \<in> A \<Longrightarrow> i \<noteq> j \<Longrightarrow> coprime (f i) (f j)"
  shows   "Carmichael (\<Prod>i\<in>A. f i) = (LCM i\<in>A. Carmichael (f i))"
  using assms by (induction A rule: finite_induct)
                 (simp, simp, subst Carmichael_mult_coprime[OF prod_coprime_right], auto)

text \<open>
  Since $\lambda$ distributes over coprime factors and we know the value of $\lambda(p^k)$
  for prime $p$, we can now give a closed formula for $\lambda(n)$ in terms of the prime
  factorisation of $n$:
\<close>
theorem Carmichael_closed_formula:
  "Carmichael n =
     (LCM p\<in>prime_factors n. let k = multiplicity p n
                             in  if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
  (is "_ = Lcm ?A")
proof (cases "n = 0")
  case False
  hence "n = (\<Prod>p\<in>prime_factors n. p ^ multiplicity p n)"
    using prime_factorization_nat by blast
  also have "Carmichael \<dots> =
               (LCM p\<in>prime_factors n. Carmichael (p ^ multiplicity p n))"
    by (subst Carmichael_prod_coprime) (auto simp: in_prime_factors_iff primes_coprime)
  also have "(\<lambda>p. Carmichael (p ^ multiplicity p n)) ` prime_factors n = ?A"
    by (intro image_cong)
       (auto simp: Let_def Carmichael_prime_power prime_factors_multiplicity)
  finally show ?thesis .
qed auto

corollary even_Carmichael:
  assumes "n > 2"
  shows   "even (Carmichael n)"
proof (cases "\<exists>k. n = 2 ^ k")
  case True
  then obtain k where [simp]: "n = 2 ^ k" by auto
  from assms have "k \<noteq> 0" "k \<noteq> 1" by (auto intro!: Nat.gr0I)
  hence "k \<ge> 2" by auto
  thus ?thesis by (auto simp: Carmichael_twopow)
next
  case False
  from assms have "n \<noteq> 0" by auto
  from False have "\<exists>p\<in>prime_factors n. p \<noteq> 2"
    using assms Ex_other_prime_factor[of n 2] by auto
  from divide_out_primepow_ex[OF \<open>n \<noteq> 0\<close> this]
  obtain p k n'
    where p:
      "p \<noteq> 2"
      "prime p"
      "p dvd n"
      "\<not> p dvd n'"
      "0 < k"
      "n = p ^ k * n'" .
  from p have coprime: "coprime (p ^ k) n'"
    using p prime_imp_coprime by auto
  have "odd p"
    using p primes_dvd_imp_eq[of 2 p] by auto
  have "even (Carmichael (p ^ k))"
    using p \<open>odd p\<close> by (auto simp: Carmichael_prime_power)
  with p coprime show ?thesis
    by (auto simp: Carmichael_mult_coprime intro!: dvd_lcmI1)
qed

lemma eval_Carmichael:
  assumes "prime_factorization n = A"
  shows     "Carmichael n = (LCM p \<in> set_mset A.
               let k = count A p in if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
  unfolding assms [symmetric] Carmichael_closed_formula
  by (intro arg_cong[where f = Lcm] image_cong) (auto simp: Let_def count_prime_factorization)

text \<open>
  Any residue ring always contains a $\lambda$-root, i.\,e.\ an element whose
  order is $\lambda(n)$.
\<close>
theorem Carmichael_root_exists:
  assumes "n > (0::nat)"
  obtains g where "g \<in> totatives n" and "ord n g = Carmichael n"
proof (cases "n = 1")
  case True
  thus ?thesis by (intro that[of 1]) (auto simp: totatives_def)
next
  case False
  have primepow: "\<exists>g. coprime (p ^ k) g \<and> ord (p ^ k) g = Carmichael (p ^ k)"
    if pk: "prime p" "k > 0" for p k
  proof (cases "p = 2")
    case [simp]: True
    from \<open>k > 0\<close> consider "k = 1" | "k = 2" | "k \<ge> 3" by force
    thus ?thesis
    proof cases
      assume "k = 1"
      thus ?thesis by (intro exI[of _ 1]) auto
    next
      assume [simp]: "k = 2"
      have "coprime 4 (3::nat)"
        by (auto simp: coprime_iff_gcd_eq_1 gcd_non_0_nat)
      thus ?thesis by (intro exI[of _ 3]) auto
    next
      assume k: "k \<ge> 3"
      have "coprime (2 ^ k :: nat) 3" by auto
      thus ?thesis using k
        by (intro exI[of _ 3]) (auto simp: ord_twopow_3_5 Carmichael_twopow)
    qed
  next
    case False
    hence "odd p" using \<open>prime p\<close>
      using primes_dvd_imp_eq two_is_prime_nat by blast
    then obtain g where "residue_primroot (p ^ k) g"
      using residue_primroot_odd_prime_power_exists[of p] pk by metis
    thus ?thesis using False pk
      by (intro exI[of _ g])
         (auto simp: Carmichael_prime_power residue_primroot_def totient_prime_power)
  qed

  define P where "P = prime_factors n"
  define k where "k = (\<lambda>p. multiplicity p n)"
  have "\<forall>p\<in>P. \<exists>g. coprime (p ^ k p) g \<and> ord (p ^ k p) g = Carmichael (p ^ k p)"
    using primepow by (auto simp: P_def k_def prime_factors_multiplicity)
  hence "\<exists>g. \<forall>p\<in>P. coprime (p ^ k p) (g p) \<and> ord (p ^ k p) (g p) = Carmichael (p ^ k p)"
    by (subst (asm) bchoice_iff)
  then obtain g where g: "\<And>p. p \<in> P \<Longrightarrow> coprime (p ^ k p) (g p)"
                         "\<And>p. p \<in> P \<Longrightarrow> ord (p ^ k p) (g p) = Carmichael (p ^ k p)" by metis
  have "\<exists>x. \<forall>i\<in>P. [x = g i] (mod i ^ k i)"
    by (intro chinese_remainder_nat)
       (auto simp: P_def k_def in_prime_factors_iff primes_coprime)
  then obtain x where x: "\<And>p. p \<in> P \<Longrightarrow> [x = g p] (mod p ^ k p)" by metis

  have "n = (\<Prod>p\<in>P. p ^ k p)"
    using assms unfolding P_def k_def by (rule prime_factorization_nat)
  also have "ord \<dots> x = (LCM p\<in>P. ord (p ^ k p) x)"
    by (intro ord_modulus_prod_coprime) (auto simp: P_def in_prime_factors_iff primes_coprime)
  also have "(\<lambda>p. ord (p ^ k p) x) ` P = (\<lambda>p. ord (p ^ k p) (g p)) ` P"
    by (intro image_cong ord_cong x) auto
  also have "\<dots> = (\<lambda>p. Carmichael (p ^ k p)) ` P"
    by (intro image_cong g) auto
  also have "Lcm \<dots> = Carmichael (\<Prod>p\<in>P. p ^ k p)"
    by (intro Carmichael_prod_coprime [symmetric])
       (auto simp: P_def in_prime_factors_iff primes_coprime)
  also have "(\<Prod>p\<in>P. p ^ k p) = n"
    using assms unfolding P_def k_def by (rule prime_factorization_nat [symmetric])
  finally have "ord n x = Carmichael n" .
  moreover from this have "coprime n x"
    by (cases "coprime n x") (auto split: if_splits)
  ultimately show ?thesis using assms False
    by (intro that[of "x mod n"])
       (auto simp: totatives_def coprime_commute coprime_absorb_left intro!: Nat.gr0I)
qed

text \<open>
  This also means that the Carmichael number is not only the LCM of the orders
  of the elements of the residue ring, but indeed the maximum of the orders.
\<close>
lemma Carmichael_altdef:
  "Carmichael n = (if n = 0 then 1 else Max (ord n ` totatives n))"
proof (cases "n = 0")
  case False
  have "Carmichael n = Max (ord n ` totatives n)"
  proof (intro antisym Max.boundedI Max.coboundedI)
    fix k assume k: "k \<in> ord n ` totatives n"
    thus "k \<le> Carmichael n"
    proof (cases "n = 1")
      case False
      with \<open>n \<noteq> 0\<close> have "n > 1" by linarith
      thus ?thesis using k \<open>n \<noteq> 0\<close>
        by (intro dvd_imp_le)
           (auto intro!: ord_dvd_Carmichael simp: totatives_def coprime_commute)
    qed auto
  next
    obtain g where "g \<in> totatives n" and "ord n g = Carmichael n"
      using Carmichael_root_exists[of n] \<open>n \<noteq> 0\<close> by auto
    thus "Carmichael n \<in> ord n ` totatives n" by force
  qed (use \<open>n \<noteq> 0\<close> in auto)
  thus ?thesis using False by simp
qed auto

subsection \<open>Existence of primitive roots for general moduli\<close>

text \<open>
  We now related Carmichael's function to the existence of primitive roots and, in the end,
  use this to show precisely which moduli have primitive roots and which do not.

  The first criterion for the existence of a primitive root is this: A primitive root modulo $n$
  exists iff $\lambda(n) = \varphi(n)$.
\<close>
lemma Carmichael_eq_totient_imp_primroot:
  assumes "n > 0" and "Carmichael n = totient n"
  shows   "\<exists>g. residue_primroot n g"
proof -
  from \<open>n > 0\<close> obtain g where "g \<in> totatives n" and "ord n g = Carmichael n"
    using Carmichael_root_exists[of n] by metis
  with assms show ?thesis by (auto simp: residue_primroot_def totatives_def coprime_commute)
qed

theorem residue_primroot_iff_Carmichael:
  "(\<exists>g. residue_primroot n g) \<longleftrightarrow> Carmichael n = totient n \<and> n > 0"
proof safe
  fix g assume g: "residue_primroot n g"
  thus "n > 0" by (auto simp: residue_primroot_def)
  have "coprime n g" by (rule ccontr) (use g in \<open>auto simp: residue_primroot_def\<close>)

  show "Carmichael n = totient n"
  proof (cases "n = 1")
    case False
    with \<open>n > 0\<close> have "n > 1" by auto
    with \<open>coprime n g\<close> have "ord n g dvd Carmichael n"
      by (intro ord_dvd_Carmichael) auto
    thus ?thesis using g by (intro dvd_antisym Carmichael_dvd_totient)
                            (auto simp: residue_primroot_def)
  qed auto
qed (use Carmichael_eq_totient_imp_primroot[of n] in auto)

text \<open>
  Any primitive root modulo $mn$ for coprime $m$, $n$ is also a primitive root modulo $m$ and $n$.
  The converse does not hold in general.
\<close>
lemma residue_primroot_modulus_mult_coprimeD:
  assumes "coprime m n" and "residue_primroot (m * n) g"
  shows   "residue_primroot m g" "residue_primroot n g"
proof -
  have *: "m > 0" "n > 0" "coprime m g" "coprime n g"
          "lcm (ord m g) (ord n g) = totient m * totient n"
    using assms
    by (auto simp: residue_primroot_def ord_modulus_mult_coprime totient_mult_coprime)

  define a b where "a = totient m div ord m g" and "b = totient n div ord n g"
  have ab: "totient m = ord m g * a" "totient n = ord n g * b"
    using * by (auto simp: a_def b_def order_divides_totient)

  have "a = 1" "b = 1" "coprime (ord m g) (ord n g)"
    unfolding coprime_iff_gcd_eq_1 using * by (auto simp: ab lcm_nat_def dvd_div_eq_mult ord_eq_0)
  with ab and * show "residue_primroot m g" "residue_primroot n g"
    by (auto simp: residue_primroot_def)
qed

text \<open>
  If a primitive root modulo $mn$ exists for coprime $m, n$, then $\lambda(m)$ and $\lambda(n)$
  must also be coprime. This is helpful in establishing that there are no primitive roots
  modulo $mn$ by showing e.\,g.\ that $\lambda(m)$ and $\lambda(n)$ are both even.
\<close>
lemma residue_primroot_modulus_mult_coprime_imp_Carmichael_coprime:
  assumes "coprime m n" and "residue_primroot (m * n) g"
  shows   "coprime (Carmichael m) (Carmichael n)"
proof -
  from residue_primroot_modulus_mult_coprimeD[OF assms]
    have *: "residue_primroot m g" "residue_primroot n g" by auto
  hence [simp]: "Carmichael m = totient m" "Carmichael n = totient n"
    by (simp_all add: residue_primroot_Carmichael)
  from * have mn: "m > 0" "n > 0" by (auto simp: residue_primroot_def)

  from assms have "Carmichael (m * n) = totient (m * n) \<and> n > 0"
    using residue_primroot_iff_Carmichael[of "m * n"] by auto
  with assms have "lcm (totient m) (totient n) = totient m * totient n"
    by (simp add: Carmichael_mult_coprime totient_mult_coprime)
  thus ?thesis unfolding coprime_iff_gcd_eq_1 using mn
    by (simp add: lcm_nat_def dvd_div_eq_mult)
qed

text \<open>
  The following moduli are precisely those that have primitive roots.
\<close>
definition cyclic_moduli :: "nat set" where
  "cyclic_moduli = {1, 2, 4} \<union> {p ^ k |p k. prime p \<and> odd p \<and> k > 0} \<union>
                     {2 * p ^ k |p k. prime p \<and> odd p \<and> k > 0}"

theorem residue_primroot_iff_in_cyclic_moduli:
  "(\<exists>g. residue_primroot m g) \<longleftrightarrow> m \<in> cyclic_moduli"
proof -
  have "(\<exists>g. residue_primroot m g)" if "m \<in> cyclic_moduli"
  using that unfolding cyclic_moduli_def
  by (intro Carmichael_eq_totient_imp_primroot)
     (auto dest: prime_gt_0_nat simp: Carmichael_prime_power totient_prime_power
                 Carmichael_mult_coprime totient_mult_coprime)

  moreover have "\<not>(\<exists>g. residue_primroot m g)" if "m \<notin> cyclic_moduli"
  proof (cases "m = 0")
    case False
    with that have [simp]: "m > 0" "m \<noteq> 1" by (auto simp: cyclic_moduli_def)
    show ?thesis
    proof (cases "\<exists>k. m = 2 ^ k")
      case True
      then obtain k where [simp]: "m = 2 ^ k" by auto
      with that have "k \<noteq> 0 \<and> k \<noteq> 1 \<and> k \<noteq> 2" by (auto simp: cyclic_moduli_def)
      hence "k \<ge> 3" by auto
      thus ?thesis by (subst residue_primroot_iff_Carmichael)
                      (auto simp: Carmichael_twopow totient_prime_power)
    next
      case False
      hence "\<exists>p\<in>prime_factors m. p \<noteq> 2"
        using Ex_other_prime_factor[of m 2] by auto
      from divide_out_primepow_ex[OF \<open>m \<noteq> 0\<close> this]
      obtain p k m' where p: "p \<noteq> 2" "prime p" "p dvd m" "\<not>p dvd m'" "0 < k" "m = p ^ k * m'"
        by metis
      have "odd p"
        using p primes_dvd_imp_eq[of 2 p] by auto
      from p have coprime: "coprime (p ^ k) m'"
        using p prime_imp_coprime by auto
      have "m \<in> cyclic_moduli" if "m' = 1"
        using that p \<open>odd p\<close> by (auto simp: cyclic_moduli_def)
      moreover have "m \<in> cyclic_moduli" if "m' = 2"
      proof -
        have "m = 2 * p ^ k" using p that by (simp add: mult.commute)
        thus "m \<in> cyclic_moduli" using p \<open>odd p\<close>
          unfolding cyclic_moduli_def by blast
      qed
      moreover have "m' \<noteq> 0" using p by (intro notI) auto
      ultimately have "m' \<noteq> 0 \<and>m' \<noteq> 1 \<and> m' \<noteq> 2" using that by auto
      hence "m' > 2" by linarith

      show ?thesis
      proof
        assume "\<exists>g. residue_primroot m g"
        with coprime p have coprime': "coprime (p - 1) (Carmichael m')"
          using residue_primroot_modulus_mult_coprime_imp_Carmichael_coprime[OF coprime]
          by (auto simp: Carmichael_prime_power)
        moreover have "even (p - 1)" "even (Carmichael m')"
          using \<open>m' > 2\<close> \<open>odd p\<close> by (auto intro!: even_Carmichael)
        ultimately show False by force
      qed
    qed
  qed auto

  ultimately show ?thesis by metis
qed

lemma residue_primroot_is_generator:
  assumes "m > 1" and "residue_primroot m g"
  shows   "bij_betw (\<lambda>i. g ^ i mod m) {..<totient m} (totatives m)"
  unfolding bij_betw_def
proof
  from assms have [simp]: "ord m g = totient m"
    by (simp add: residue_primroot_def)
  from assms have "coprime m g" by (simp add: residue_primroot_def)
  hence "inj_on (\<lambda>i. g ^ i mod m) {..<ord m g}"
    by (intro inj_power_mod)
  thus inj: "inj_on (\<lambda>i. g ^ i mod m) {..<totient m}"
    by simp

  show "(\<lambda>i. g ^ i mod m) ` {..<totient m} = totatives m"
  proof (rule card_subset_eq)
    show "card ((\<lambda>i. g ^ i mod m) ` {..<totient m}) = card (totatives m)"
      using inj by (subst card_image) (auto simp: totient_def)
    show "(\<lambda>i. g ^ i mod m) ` {..<totient m} \<subseteq> totatives m"
      using \<open>m > 1\<close> \<open>coprime m g\<close> power_in_totatives[of m g] by blast
  qed auto
qed

text \<open>
  Given one primitive root \<open>g\<close>, all the primitive roots are powers $g^i$ for
  $1\leq i \leq \varphi(n)$ with $\text{gcd}(i, \varphi(n)) = 1$.
\<close>
theorem residue_primroot_bij_betw_primroots:
  assumes "m > 1" and "residue_primroot m g"
  shows   "bij_betw (\<lambda>i. g ^ i mod m) (totatives (totient m))
                                      {g\<in>totatives m. residue_primroot m g}"
proof (cases "m = 2")
  case [simp]: True
  have [simp]: "totatives 2 = {1}"
    by (auto simp: totatives_def elim!: oddE)
  from assms have "odd g"
    by (auto simp: residue_primroot_def)
  hence pow_eq: "(\<lambda>i. g ^ i mod m) = (\<lambda>_. 1)"
    by (auto simp: fun_eq_iff mod_2_eq_odd)
  have "{g \<in> totatives m. residue_primroot m g} = {1}"
    by (auto simp: residue_primroot_def)
  thus ?thesis using pow_eq by (auto simp: bij_betw_def)
next
  case False
  thus ?thesis unfolding bij_betw_def
  proof safe
    from assms False have "m > 2" by auto
    from assms \<open>m > 2\<close> have "totient m > 1" by (intro totient_gt_1) auto
    from assms have [simp]: "ord m g = totient m"
      by (simp add: residue_primroot_def)
    from assms have "coprime m g" by (simp add: residue_primroot_def)
    hence "inj_on (\<lambda>i. g ^ i mod m) {..<ord m g}"
      by (intro inj_power_mod)
    thus "inj_on (\<lambda>i. g ^ i mod m) (totatives (totient m))"
      by (rule inj_on_subset)
         (use assms \<open>totient m > 1\<close> in \<open>auto simp: totatives_less residue_primroot_def\<close>)

    {
      fix i assume i: "i \<in> totatives (totient m)"
      from \<open>coprime m g\<close> and \<open>m > 2\<close> show "g ^ i mod m \<in> totatives m"
        by (intro power_in_totatives) auto
      show "residue_primroot m (g ^ i mod m)"
        using i \<open>m > 2\<close> \<open>coprime m g\<close>
        by (auto simp: residue_primroot_def coprime_commute ord_power totatives_def)
    }
    {
      fix x assume x: "x \<in> totatives m" "residue_primroot m x"
      then obtain i where i: "i < totient m" "x = (g ^ i mod m)"
        using assms residue_primroot_is_generator[of m g] by (auto simp: bij_betw_def)
      from i x \<open>m > 2\<close> have "i > 0" by (intro Nat.gr0I) (auto simp: residue_primroot_1_iff)
      have "totient m div gcd i (totient m) = totient m"
        using x i \<open>coprime m g\<close> by (auto simp add: residue_primroot_def ord_power)
      hence "coprime i (totient m)"
        unfolding coprime_iff_gcd_eq_1 using assms by (subst (asm) dvd_div_eq_mult) auto
      with i \<open>i > 0\<close> have "i \<in> totatives (totient m)" by (auto simp: totatives_def)
      thus "x \<in> (\<lambda>i. g ^ i mod m) ` totatives (totient m)" using i by auto
    }
  qed
qed

text \<open>
  It follows from the above statement that any residue ring modulo \<open>n\<close> that \<^emph>\<open>has\<close> primitive roots
  has exactly $\varphi(\varphi(n))$ of them.
\<close>
corollary card_residue_primroots:
  assumes "\<exists>g. residue_primroot m g"
  shows   "card {g\<in>totatives m. residue_primroot m g} = totient (totient m)"
proof (cases "m = 1")
  case [simp]: True
  have "{g \<in> totatives m. residue_primroot m g} = {1}"
    by (auto simp: residue_primroot_def)
  thus ?thesis by simp
next
  case False
  from assms obtain g where g: "residue_primroot m g" by auto
  hence "m \<noteq> 0" by (intro notI) auto
  with \<open>m \<noteq> 1\<close> have "m > 1" by linarith
  from this g have "bij_betw (\<lambda>i. g ^ i mod m) (totatives (totient m))
                      {g\<in>totatives m. residue_primroot m g}"
    by (rule residue_primroot_bij_betw_primroots)
  hence "card (totatives (totient m)) = card {g\<in>totatives m. residue_primroot m g}"
    by (rule bij_betw_same_card)
  thus ?thesis by (simp add: totient_def)
qed

corollary card_residue_primroots':
  "card {g\<in>totatives m. residue_primroot m g} =
     (if m \<in> cyclic_moduli then totient (totient m) else 0)"
  by (simp add: residue_primroot_iff_in_cyclic_moduli [symmetric] card_residue_primroots)

text \<open>
  As an example, we evaluate $\lambda(122200)$ using the prime factorisation.
\<close>
lemma "Carmichael 122200 = 1380"
proof -
  have "prime_factorization (2^3 * 5^2 * 13 * 47) = {#2, 2, 2, 5, 5, 13, 47::nat#}"
    by (intro prime_factorization_eqI) auto
  from eval_Carmichael[OF this] show "Carmichael 122200 = 1380"
    by (simp add: lcm_nat_def gcd_non_0_nat)
qed

(* TODO: definition of index ("discrete logarithm") *)

end


theory MyMaths
  imports Main
begin
definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
"xor A B \<equiv> (A & ~B) | (~A & B)"

definition J :: "nat set" where
"J = {n . n > 0}"
definition U :: "nat set" where
"U = {n . n > 0}"
definition T :: "nat set" where
"T = {n . n > 0}"
definition I :: "nat set" where
"I = {n . n > 0}"
definition V :: "nat set" where
"V = {n . n > 0}"
definition K :: "nat set" where
"K = {n . n > 0}"
definition H :: "nat set" where
"H = {n . n > 0}"
definition L :: "nat set" where
"L = {n . n > 0}"

lemma "(\<forall>j \<in> J.\<forall>u \<in> U.\<forall>t \<in> T.\<forall>l \<in> L. P j u t l) \<longrightarrow> (\<forall>i \<in> I.\<forall>v \<in> V.\<forall>k \<in> K.\<forall>h \<in> H. Q i v k h)
\<Longrightarrow> \<not>(\<forall>j \<in> J.\<forall>u \<in> U.\<forall>t \<in> T.\<forall>l \<in> L. P j u t l) \<or> (\<forall>i \<in> I.\<forall>v \<in> V.\<forall>k \<in> K.\<forall>h \<in> H. Q i v k h)"
  apply (auto)
  done

lemma "(\<forall>l \<in> L.\<forall>j \<in> J.\<forall>u \<in> U.\<forall>t \<in> T. \<not> P j u t l) \<or> (\<exists>i \<in> I.\<exists>v \<in> V.\<forall>k \<in> K. (\<exists>h \<in> H. (Q i v k h) \<and> \<forall>h1 \<noteq> h. (\<not>Q i v k h1)))
\<Longrightarrow> (\<exists>i \<in> I.\<exists>v \<in> V.\<forall>k \<in> K. (\<exists>h \<in> H. (Q i v k h) \<and> \<forall>h1 \<noteq> h. (\<not>Q i v k h1))) \<or> (\<forall>l \<in> L.\<forall>j \<in> J.\<forall>u \<in> U.\<forall>t \<in> T. \<not> P j u t l)"
  apply (auto)
  done

lemma test1: "(\<forall>j\<in>J.\<forall>u\<in>U.\<forall>t\<in>T.\<forall>l\<in>L.\<forall>l1\<noteq>l. \<not>P j u t l1) \<or> (\<exists>i\<in>I.\<exists>v\<in>V.\<forall>k\<in>K.\<Or>h\<in>H.Q i v k h)
\<Longrightarrow> (\<exists>i\<in>I.\<exists>v\<in>V.\<forall>k\<in>K.\<Or>h\<in>H.Q i v k h) \<or> (\<forall>j\<in>J.\<forall>u\<in>U.\<forall>t\<in>T.\<forall>l\<in>L.\<forall>l1\<noteq>l. \<not>P j u t l1)"
  apply (auto)
  done

(*lemma test1: "(\<And>l \<in> L.\<And>j\<in>J.\<And>u\<in>U.\<And>t\<in>T. \<not>P j u t l)
  \<or> (\<Or>h\<in>H.\<Or>i\<in>I.\<Or>v\<in>V.\<And>k\<in>K.(Q i v k h \<and> \<And>h1\<noteq>h. ~Q i v k h1))" *)
lemma
  assumes "\<forall>x.\<exists>y.\<forall>z. P x y z"
  shows "\<forall>x.\<exists>y.\<forall>z. P x y (z-2)"
using assms by force

lemma "xor A (~A)"
using [[simp_trace=true]]
  apply(simp add: xor_def)
  done

lemma conj_rule: "\<lbrakk>P; Q\<rbrakk> \<Longrightarrow> (Q & P)"
  apply (rule conjI)
   apply assumption
   apply assumption
  done

lemma conj_rule_1: "\<lbrakk>P; Q\<rbrakk> \<Longrightarrow> (Q & P)"
  apply (auto)
  done

lemma imp_unc: "(P \<longrightarrow> Q) \<Longrightarrow> (~P | Q)"
  apply (auto)
  done
end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_BSortIsSort
  imports "../../Test_Base"
begin

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

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun sort2 :: "int => int => int list" where
  "sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun pairs :: "int list => int list => int list" where
  "pairs (nil2) z = z"
| "pairs (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "pairs (cons2 z2 x2) (cons2 x3 x4) =
     x (sort2 z2 x3) (pairs x2 x4)"

fun stitch :: "int list => int list => int list" where
  "stitch (nil2) z = z"
| "stitch (cons2 z2 xs) z = cons2 z2 (pairs xs z)"

fun insert :: "int => int list => int list" where
  "insert y (nil2) = cons2 y (nil2)"
| "insert y (cons2 z2 xs) =
     (if y <= z2 then cons2 y (cons2 z2 xs) else
        cons2 z2 (insert y xs))"

fun isort :: "int list => int list" where
  "isort (nil2) = nil2"
| "isort (cons2 z xs) = insert z (isort xs)"

function evens :: "'a list => 'a list"
  and odds :: "'a list => 'a list" where
  "evens (nil2) = nil2"
| "evens (cons2 z xs) = cons2 z (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 z xs) = evens xs"
  by pat_completeness auto

(*fun did not finish the proof*)
function bmerge :: "int list => int list => int list" where
  "bmerge (nil2) z = nil2"
| "bmerge (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "bmerge (cons2 z2 x2) (cons2 x3 x4) =
     (let fail :: int list =
       stitch
         (bmerge (evens (cons2 z2 x2)) (evens (cons2 x3 x4)))
         (bmerge (odds (cons2 z2 x2)) (odds (cons2 x3 x4)))
     in (case x2 of
           nil2 =>
             (case x4 of
                nil2 => sort2 z2 x3
                | cons2 x5 x6 => fail)
           | cons2 x7 x8 => fail))"
  by pat_completeness auto

(*fun did not finish the proof*)
function bsort :: "int list => int list" where
  "bsort (nil2) = nil2"
| "bsort (cons2 z (nil2)) = cons2 z (nil2)"
| "bsort (cons2 z (cons2 x2 x3)) =
     bmerge
       (bsort (evens (cons2 z (cons2 x2 x3))))
       (bsort (odds (cons2 z (cons2 x2 x3))))"
  by pat_completeness auto

theorem property0 :
  "((bsort xs) = (isort xs))"
  oops

end


(* Author: Florian Haftmann, TU Muenchen *)

section \<open>Permutations as abstract type\<close>

theory Perm
imports Main
begin

text \<open>
  This theory introduces basics about permutations, i.e. almost
  everywhere fix bijections.  But it is by no means complete.
  Grieviously missing are cycles since these would require more
  elaboration, e.g. the concept of distinct lists equivalent
  under rotation, which maybe would also deserve its own theory.
  But see theory \<open>src/HOL/ex/Perm_Fragments.thy\<close> for
  fragments on that.
\<close>

subsection \<open>Abstract type of permutations\<close>

typedef 'a perm = "{f :: 'a \<Rightarrow> 'a. bij f \<and> finite {a. f a \<noteq> a}}"
  morphisms "apply" Perm
proof
  show "id \<in> ?perm" by simp
qed

setup_lifting type_definition_perm

notation "apply" (infixl "\<langle>$\<rangle>" 999)

lemma bij_apply [simp]:
  "bij (apply f)"
  using "apply" [of f] by simp

lemma perm_eqI:
  assumes "\<And>a. f \<langle>$\<rangle> a = g \<langle>$\<rangle> a"
  shows "f = g"
  using assms by transfer (simp add: fun_eq_iff)

lemma perm_eq_iff:
  "f = g \<longleftrightarrow> (\<forall>a. f \<langle>$\<rangle> a = g \<langle>$\<rangle> a)"
  by (auto intro: perm_eqI)

lemma apply_inj:
  "f \<langle>$\<rangle> a = f \<langle>$\<rangle> b \<longleftrightarrow> a = b"
  by (rule inj_eq) (rule bij_is_inj, simp)

lift_definition affected :: "'a perm \<Rightarrow> 'a set"
  is "\<lambda>f. {a. f a \<noteq> a}" .

lemma in_affected:
  "a \<in> affected f \<longleftrightarrow> f \<langle>$\<rangle> a \<noteq> a"
  by transfer simp

lemma finite_affected [simp]:
  "finite (affected f)"
  by transfer simp

lemma apply_affected [simp]:
  "f \<langle>$\<rangle> a \<in> affected f \<longleftrightarrow> a \<in> affected f"
proof transfer
  fix f :: "'a \<Rightarrow> 'a" and a :: 'a
  assume "bij f \<and> finite {b. f b \<noteq> b}"
  then have "bij f" by simp
  interpret bijection f by standard (rule \<open>bij f\<close>)
  have "f a \<in> {a. f a = a} \<longleftrightarrow> a \<in> {a. f a = a}" (is "?P \<longleftrightarrow> ?Q")
    by auto
  then show "f a \<in> {a. f a \<noteq> a} \<longleftrightarrow> a \<in> {a. f a \<noteq> a}"
    by simp
qed

lemma card_affected_not_one:
  "card (affected f) \<noteq> 1"
proof
  interpret bijection "apply f"
    by standard (rule bij_apply)
  assume "card (affected f) = 1"
  then obtain a where *: "affected f = {a}"
    by (rule card_1_singletonE)
  then have **: "f \<langle>$\<rangle> a \<noteq> a"
    by (simp flip: in_affected)
  with * have "f \<langle>$\<rangle> a \<notin> affected f"
    by simp
  then have "f \<langle>$\<rangle> (f \<langle>$\<rangle> a) = f \<langle>$\<rangle> a"
    by (simp add: in_affected)
  then have "inv (apply f) (f \<langle>$\<rangle> (f \<langle>$\<rangle> a)) = inv (apply f) (f \<langle>$\<rangle> a)"
    by simp
  with ** show False by simp
qed

subsection \<open>Identity, composition and inversion\<close>

instantiation Perm.perm :: (type) "{monoid_mult, inverse}"
begin

lift_definition one_perm :: "'a perm"
  is id
  by simp

lemma apply_one [simp]:
  "apply 1 = id"
  by (fact one_perm.rep_eq)

lemma affected_one [simp]:
  "affected 1 = {}"
  by transfer simp

lemma affected_empty_iff [simp]:
  "affected f = {} \<longleftrightarrow> f = 1"
  by transfer auto

lift_definition times_perm :: "'a perm \<Rightarrow> 'a perm \<Rightarrow> 'a perm"
  is comp
proof
  fix f g :: "'a \<Rightarrow> 'a"
  assume "bij f \<and> finite {a. f a \<noteq> a}"
    "bij g \<and>finite {a. g a \<noteq> a}"
  then have "finite ({a. f a \<noteq> a} \<union> {a. g a \<noteq> a})"
    by simp
  moreover have "{a. (f \<circ> g) a \<noteq> a} \<subseteq> {a. f a \<noteq> a} \<union> {a. g a \<noteq> a}"
    by auto
  ultimately show "finite {a. (f \<circ> g) a \<noteq> a}"
    by (auto intro: finite_subset)
qed (auto intro: bij_comp)

lemma apply_times:
  "apply (f * g) = apply f \<circ> apply g"
  by (fact times_perm.rep_eq)

lemma apply_sequence:
  "f \<langle>$\<rangle> (g \<langle>$\<rangle> a) = apply (f * g) a"
  by (simp add: apply_times)

lemma affected_times [simp]:
  "affected (f * g) \<subseteq> affected f \<union> affected g"
  by transfer auto

lift_definition inverse_perm :: "'a perm \<Rightarrow> 'a perm"
  is inv
proof transfer
  fix f :: "'a \<Rightarrow> 'a" and a
  assume "bij f \<and> finite {b. f b \<noteq> b}"
  then have "bij f" and fin: "finite {b. f b \<noteq> b}"
    by auto
  interpret bijection f by standard (rule \<open>bij f\<close>)
  from fin show "bij (inv f) \<and> finite {a. inv f a \<noteq> a}"
    by (simp add: bij_inv)
qed

instance
  by standard (transfer; simp add: comp_assoc)+

end

lemma apply_inverse:
  "apply (inverse f) = inv (apply f)"
  by (fact inverse_perm.rep_eq)

lemma affected_inverse [simp]:
  "affected (inverse f) = affected f"
proof transfer
  fix f :: "'a \<Rightarrow> 'a" and a
  assume "bij f \<and> finite {b. f b \<noteq> b}"
  then have "bij f" by simp
  interpret bijection f by standard (rule \<open>bij f\<close>)
  show "{a. inv f a \<noteq> a} = {a. f a \<noteq> a}"
    by simp
qed

global_interpretation perm: group times "1::'a perm" inverse
proof
  fix f :: "'a perm"
  show "1 * f = f"
    by transfer simp
  show "inverse f * f = 1"
  proof transfer
    fix f :: "'a \<Rightarrow> 'a" and a
    assume "bij f \<and> finite {b. f b \<noteq> b}"
    then have "bij f" by simp
    interpret bijection f by standard (rule \<open>bij f\<close>)
    show "inv f \<circ> f = id"
      by simp
  qed
qed

declare perm.inverse_distrib_swap [simp]

lemma perm_mult_commute:
  assumes "affected f \<inter> affected g = {}"
  shows "g * f = f * g"
proof (rule perm_eqI)
  fix a
  from assms have *: "a \<in> affected f \<Longrightarrow> a \<notin> affected g"
    "a \<in> affected g \<Longrightarrow> a \<notin> affected f" for a
    by auto
  consider "a \<in> affected f \<and> a \<notin> affected g
        \<and> f \<langle>$\<rangle> a \<in> affected f"
    | "a \<notin> affected f \<and> a \<in> affected g
        \<and> f \<langle>$\<rangle> a \<notin> affected f"
    | "a \<notin> affected f \<and> a \<notin> affected g"
    using assms by auto
  then show "(g * f) \<langle>$\<rangle> a = (f * g) \<langle>$\<rangle> a"
  proof cases
    case 1
    with * have "f \<langle>$\<rangle> a \<notin> affected g"
      by auto
    with 1 show ?thesis by (simp add: in_affected apply_times)
  next
    case 2
    with * have "g \<langle>$\<rangle> a \<notin> affected f"
      by auto
    with 2 show ?thesis by (simp add: in_affected apply_times)
  next
    case 3
    then show ?thesis by (simp add: in_affected apply_times)
  qed
qed

lemma apply_power:
  "apply (f ^ n) = apply f ^^ n"
  by (induct n) (simp_all add: apply_times)

lemma perm_power_inverse:
  "inverse f ^ n = inverse ((f :: 'a perm) ^ n)"
proof (induct n)
  case 0 then show ?case by simp
next
  case (Suc n)
  then show ?case
    unfolding power_Suc2 [of f] by simp
qed

subsection \<open>Orbit and order of elements\<close>

definition orbit :: "'a perm \<Rightarrow> 'a \<Rightarrow> 'a set"
where
  "orbit f a = range (\<lambda>n. (f ^ n) \<langle>$\<rangle> a)"

lemma in_orbitI:
  assumes "(f ^ n) \<langle>$\<rangle> a = b"
  shows "b \<in> orbit f a"
  using assms by (auto simp add: orbit_def)

lemma apply_power_self_in_orbit [simp]:
  "(f ^ n) \<langle>$\<rangle> a \<in> orbit f a"
  by (rule in_orbitI) rule

lemma in_orbit_self [simp]:
  "a \<in> orbit f a"
  using apply_power_self_in_orbit [of _ 0] by simp

lemma apply_self_in_orbit [simp]:
  "f \<langle>$\<rangle> a \<in> orbit f a"
  using apply_power_self_in_orbit [of _ 1] by simp

lemma orbit_not_empty [simp]:
  "orbit f a \<noteq> {}"
  using in_orbit_self [of a f] by blast

lemma not_in_affected_iff_orbit_eq_singleton:
  "a \<notin> affected f \<longleftrightarrow> orbit f a = {a}" (is "?P \<longleftrightarrow> ?Q")
proof
  assume ?P
  then have "f \<langle>$\<rangle> a = a"
    by (simp add: in_affected)
  then have "(f ^ n) \<langle>$\<rangle> a = a" for n
    by (induct n) (simp_all add: apply_times)
  then show ?Q
    by (auto simp add: orbit_def)
next
  assume ?Q
  then show ?P
    by (auto simp add: orbit_def in_affected dest: range_eq_singletonD [of _ _ 1])
qed

definition order :: "'a perm \<Rightarrow> 'a \<Rightarrow> nat"
where
  "order f = card \<circ> orbit f"

lemma orbit_subset_eq_affected:
  assumes "a \<in> affected f"
  shows "orbit f a \<subseteq> affected f"
proof (rule ccontr)
  assume "\<not> orbit f a \<subseteq> affected f"
  then obtain b where "b \<in> orbit f a" and "b \<notin> affected f"
    by auto
  then have "b \<in> range (\<lambda>n. (f ^ n) \<langle>$\<rangle> a)"
    by (simp add: orbit_def)
  then obtain n where "b = (f ^ n) \<langle>$\<rangle> a"
    by blast
  with \<open>b \<notin> affected f\<close>
  have "(f ^ n) \<langle>$\<rangle> a \<notin> affected f"
    by simp
  then have "f \<langle>$\<rangle> a \<notin> affected f"
    by (induct n) (simp_all add: apply_times)
  with assms show False
    by simp
qed

lemma finite_orbit [simp]:
  "finite (orbit f a)"
proof (cases "a \<in> affected f")
  case False then show ?thesis
    by (simp add: not_in_affected_iff_orbit_eq_singleton)
next
  case True then have "orbit f a \<subseteq> affected f"
    by (rule orbit_subset_eq_affected)
  then show ?thesis using finite_affected
    by (rule finite_subset)
qed

lemma orbit_1 [simp]:
  "orbit 1 a = {a}"
  by (auto simp add: orbit_def)

lemma order_1 [simp]:
  "order 1 a = 1"
  unfolding order_def by simp

lemma card_orbit_eq [simp]:
  "card (orbit f a) = order f a"
  by (simp add: order_def)

lemma order_greater_zero [simp]:
  "order f a > 0"
  by (simp only: card_gt_0_iff order_def comp_def) simp

lemma order_eq_one_iff:
  "order f a = Suc 0 \<longleftrightarrow> a \<notin> affected f" (is "?P \<longleftrightarrow> ?Q")
proof
  assume ?P then have "card (orbit f a) = 1"
    by simp
  then obtain b where "orbit f a = {b}"
    by (rule card_1_singletonE)
  with in_orbit_self [of a f]
    have "b = a" by simp
  with \<open>orbit f a = {b}\<close> show ?Q
    by (simp add: not_in_affected_iff_orbit_eq_singleton)
next
  assume ?Q
  then have "orbit f a = {a}"
    by (simp add: not_in_affected_iff_orbit_eq_singleton)
  then have "card (orbit f a) = 1"
    by simp
  then show ?P
    by simp
qed

lemma order_greater_eq_two_iff:
  "order f a \<ge> 2 \<longleftrightarrow> a \<in> affected f"
  using order_eq_one_iff [of f a]
  apply (auto simp add: neq_iff)
  using order_greater_zero [of f a]
  apply simp
  done

lemma order_less_eq_affected:
  assumes "f \<noteq> 1"
  shows "order f a \<le> card (affected f)"
proof (cases "a \<in> affected f")
  from assms have "affected f \<noteq> {}"
    by simp
  then obtain B b where "affected f = insert b B"
    by blast
  with finite_affected [of f] have "card (affected f) \<ge> 1"
    by (simp add: card_insert)
  case False then have "order f a = 1"
    by (simp add: order_eq_one_iff)
  with \<open>card (affected f) \<ge> 1\<close> show ?thesis
    by simp
next
  case True
  have "card (orbit f a) \<le> card (affected f)"
    by (rule card_mono) (simp_all add: True orbit_subset_eq_affected card_mono)
  then show ?thesis
    by simp
qed

lemma affected_order_greater_eq_two:
  assumes "a \<in> affected f"
  shows "order f a \<ge> 2"
proof (rule ccontr)
  assume "\<not> 2 \<le> order f a"
  then have "order f a < 2"
    by (simp add: not_le)
  with order_greater_zero [of f a] have "order f a = 1"
    by arith
  with assms show False
    by (simp add: order_eq_one_iff)
qed

lemma order_witness_unfold:
  assumes "n > 0" and "(f ^ n) \<langle>$\<rangle> a = a"
  shows "order f a = card ((\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {0..<n})"
proof  -
  have "orbit f a = (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {0..<n}" (is "_ = ?B")
  proof (rule set_eqI, rule)
    fix b
    assume "b \<in> orbit f a"
    then obtain m where "(f ^ m) \<langle>$\<rangle> a = b"
      by (auto simp add: orbit_def)
    then have "b = (f ^ (m mod n + n * (m div n))) \<langle>$\<rangle> a"
      by simp
    also have "\<dots> = (f ^ (m mod n)) \<langle>$\<rangle> ((f ^ (n * (m div n))) \<langle>$\<rangle> a)"
      by (simp only: power_add apply_times) simp
    also have "(f ^ (n * q)) \<langle>$\<rangle> a = a" for q
      by (induct q)
        (simp_all add: power_add apply_times assms)
    finally have "b = (f ^ (m mod n)) \<langle>$\<rangle> a" .
    moreover from \<open>n > 0\<close>
    have "m mod n < n"
      by simp
    ultimately show "b \<in> ?B"
      by auto
  next
    fix b
    assume "b \<in> ?B"
    then obtain m where "(f ^ m) \<langle>$\<rangle> a = b"
      by blast
    then show "b \<in> orbit f a"
      by (rule in_orbitI)
  qed
  then have "card (orbit f a) = card ?B"
    by (simp only:)
  then show ?thesis
    by simp
qed

lemma inj_on_apply_range:
  "inj_on (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) {..<order f a}"
proof -
  have "inj_on (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) {..<n}"
    if "n \<le> order f a" for n
  using that proof (induct n)
    case 0 then show ?case by simp
  next
    case (Suc n)
    then have prem: "n < order f a"
      by simp
    with Suc.hyps have hyp: "inj_on (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) {..<n}"
      by simp
    have "(f ^ n) \<langle>$\<rangle> a \<notin> (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {..<n}"
    proof
      assume "(f ^ n) \<langle>$\<rangle> a \<in> (\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {..<n}"
      then obtain m where *: "(f ^ m) \<langle>$\<rangle> a = (f ^ n) \<langle>$\<rangle> a" and "m < n"
        by auto
      interpret bijection "apply (f ^ m)"
        by standard simp
      from \<open>m < n\<close> have "n = m + (n - m)"
        and nm: "0 < n - m" "n - m \<le> n"
        by arith+
      with * have "(f ^ m) \<langle>$\<rangle> a = (f ^ (m + (n - m))) \<langle>$\<rangle> a"
        by simp
      then have "(f ^ m) \<langle>$\<rangle> a = (f ^ m) \<langle>$\<rangle> ((f ^ (n - m)) \<langle>$\<rangle> a)"
        by (simp add: power_add apply_times)
      then have "(f ^ (n - m)) \<langle>$\<rangle> a = a"
        by simp
      with \<open>n - m > 0\<close>
      have "order f a = card ((\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {0..<n - m})"
         by (rule order_witness_unfold)
      also have "card ((\<lambda>m. (f ^ m) \<langle>$\<rangle> a) ` {0..<n - m}) \<le> card {0..<n - m}"
        by (rule card_image_le) simp
      finally have "order f a \<le> n - m"
        by simp
      with prem show False by simp
    qed
    with hyp show ?case
      by (simp add: lessThan_Suc)
  qed
  then show ?thesis by simp
qed

lemma orbit_unfold_image:
  "orbit f a = (\<lambda>n. (f ^ n) \<langle>$\<rangle> a) ` {..<order f a}" (is "_ = ?A")
proof (rule sym, rule card_subset_eq)
  show "finite (orbit f a)"
    by simp
  show "?A \<subseteq> orbit f a"
    by (auto simp add: orbit_def)
  from inj_on_apply_range [of f a]
  have "card ?A = order f a"
    by (auto simp add: card_image)
  then show "card ?A = card (orbit f a)"
    by simp
qed

lemma in_orbitE:
  assumes "b \<in> orbit f a"
  obtains n where "b = (f ^ n) \<langle>$\<rangle> a" and "n < order f a"
  using assms unfolding orbit_unfold_image by blast

lemma apply_power_order [simp]:
  "(f ^ order f a) \<langle>$\<rangle> a = a"
proof -
  have "(f ^ order f a) \<langle>$\<rangle> a \<in> orbit f a"
    by simp
  then obtain n where
    *: "(f ^ order f a) \<langle>$\<rangle> a = (f ^ n) \<langle>$\<rangle> a"
    and "n < order f a"
    by (rule in_orbitE)
  show ?thesis
  proof (cases n)
    case 0 with * show ?thesis by simp
  next
    case (Suc m)
    from order_greater_zero [of f a]
      have "Suc (order f a - 1) = order f a"
      by arith
    from Suc \<open>n < order f a\<close>
      have "m < order f a"
      by simp
    with Suc *
    have "(inverse f) \<langle>$\<rangle> ((f ^ Suc (order f a - 1)) \<langle>$\<rangle> a) =
      (inverse f) \<langle>$\<rangle> ((f ^ Suc m) \<langle>$\<rangle> a)"
      by simp
    then have "(f ^ (order f a - 1)) \<langle>$\<rangle> a =
      (f ^ m) \<langle>$\<rangle> a"
      by (simp only: power_Suc apply_times)
        (simp add: apply_sequence mult.assoc [symmetric])
    with inj_on_apply_range
    have "order f a - 1 = m"
      by (rule inj_onD)
        (simp_all add: \<open>m < order f a\<close>)
    with Suc have "n = order f a"
      by auto
    with \<open>n < order f a\<close>
    show ?thesis by simp
  qed
qed

lemma apply_power_left_mult_order [simp]:
  "(f ^ (n * order f a)) \<langle>$\<rangle> a = a"
  by (induct n) (simp_all add: power_add apply_times)

lemma apply_power_right_mult_order [simp]:
  "(f ^ (order f a * n)) \<langle>$\<rangle> a = a"
  by (simp add: ac_simps)

lemma apply_power_mod_order_eq [simp]:
  "(f ^ (n mod order f a)) \<langle>$\<rangle> a = (f ^ n) \<langle>$\<rangle> a"
proof -
  have "(f ^ n) \<langle>$\<rangle> a = (f ^ (n mod order f a + order f a * (n div order f a))) \<langle>$\<rangle> a"
    by simp
  also have "\<dots> = (f ^ (n mod order f a) * f ^ (order f a * (n div order f a))) \<langle>$\<rangle> a"
    by (simp flip: power_add)
  finally show ?thesis
    by (simp add: apply_times)
qed

lemma apply_power_eq_iff:
  "(f ^ m) \<langle>$\<rangle> a = (f ^ n) \<langle>$\<rangle> a \<longleftrightarrow> m mod order f a = n mod order f a" (is "?P \<longleftrightarrow> ?Q")
proof
  assume ?Q
  then have "(f ^ (m mod order f a)) \<langle>$\<rangle> a = (f ^ (n mod order f a)) \<langle>$\<rangle> a"
    by simp
  then show ?P
    by simp
next
  assume ?P
  then have "(f ^ (m mod order f a)) \<langle>$\<rangle> a = (f ^ (n mod order f a)) \<langle>$\<rangle> a"
    by simp
  with inj_on_apply_range
  show ?Q
    by (rule inj_onD) simp_all
qed

lemma apply_inverse_eq_apply_power_order_minus_one:
  "(inverse f) \<langle>$\<rangle> a = (f ^ (order f a - 1)) \<langle>$\<rangle> a"
proof (cases "order f a")
  case 0 with order_greater_zero [of f a] show ?thesis
    by simp
next
  case (Suc n)
  moreover have "(f ^ order f a) \<langle>$\<rangle> a = a"
    by simp
  then have *: "(inverse f) \<langle>$\<rangle> ((f ^ order f a) \<langle>$\<rangle> a) = (inverse f) \<langle>$\<rangle> a"
    by simp
  ultimately show ?thesis
    by (simp add: apply_sequence mult.assoc [symmetric])
qed

lemma apply_inverse_self_in_orbit [simp]:
  "(inverse f) \<langle>$\<rangle> a \<in> orbit f a"
  using apply_inverse_eq_apply_power_order_minus_one [symmetric]
  by (rule in_orbitI)

lemma apply_inverse_power_eq:
  "(inverse (f ^ n)) \<langle>$\<rangle> a = (f ^ (order f a - n mod order f a)) \<langle>$\<rangle> a"
proof (induct n)
  case 0 then show ?case by simp
next
  case (Suc n)
  define m where "m = order f a - n mod order f a - 1"
  moreover have "order f a - n mod order f a > 0"
    by simp
  ultimately have *: "order f a - n mod order f a = Suc m"
    by arith
  moreover from * have m2: "order f a - Suc n mod order f a = (if m = 0 then order f a else m)"
    by (auto simp add: mod_Suc)
  ultimately show ?case
    using Suc
      by (simp_all add: apply_times power_Suc2 [of _ n] power_Suc [of _ m] del: power_Suc)
        (simp add: apply_sequence mult.assoc [symmetric])
qed

lemma apply_power_eq_self_iff:
  "(f ^ n) \<langle>$\<rangle> a = a \<longleftrightarrow> order f a dvd n"
  using apply_power_eq_iff [of f n a 0]
    by (simp add: mod_eq_0_iff_dvd)

lemma orbit_equiv:
  assumes "b \<in> orbit f a"
  shows "orbit f b = orbit f a" (is "?B = ?A")
proof
  from assms obtain n where "n < order f a" and b: "b = (f ^ n) \<langle>$\<rangle> a"
    by (rule in_orbitE)
  then show "?B \<subseteq> ?A"
    by (auto simp add: apply_sequence power_add [symmetric] intro: in_orbitI elim!: in_orbitE)
  from b have "(inverse (f ^ n)) \<langle>$\<rangle> b = (inverse (f ^ n)) \<langle>$\<rangle> ((f ^ n) \<langle>$\<rangle> a)"
    by simp
  then have a: "a = (inverse (f ^ n)) \<langle>$\<rangle> b"
    by (simp add: apply_sequence)
  then show "?A \<subseteq> ?B"
    apply (auto simp add: apply_sequence power_add [symmetric] intro: in_orbitI elim!: in_orbitE)
    unfolding apply_times comp_def apply_inverse_power_eq
    unfolding apply_sequence power_add [symmetric]
    apply (rule in_orbitI) apply rule
    done
qed

lemma orbit_apply [simp]:
  "orbit f (f \<langle>$\<rangle> a) = orbit f a"
  by (rule orbit_equiv) simp

lemma order_apply [simp]:
  "order f (f \<langle>$\<rangle> a) = order f a"
  by (simp only: order_def comp_def orbit_apply)

lemma orbit_apply_inverse [simp]:
  "orbit f (inverse f \<langle>$\<rangle> a) = orbit f a"
  by (rule orbit_equiv) simp

lemma order_apply_inverse [simp]:
  "order f (inverse f \<langle>$\<rangle> a) = order f a"
  by (simp only: order_def comp_def orbit_apply_inverse)

lemma orbit_apply_power [simp]:
  "orbit f ((f ^ n) \<langle>$\<rangle> a) = orbit f a"
  by (rule orbit_equiv) simp

lemma order_apply_power [simp]:
  "order f ((f ^ n) \<langle>$\<rangle> a) = order f a"
  by (simp only: order_def comp_def orbit_apply_power)

lemma orbit_inverse [simp]:
  "orbit (inverse f) = orbit f"
proof (rule ext, rule set_eqI, rule)
  fix b a
  assume "b \<in> orbit f a"
  then obtain n where b: "b = (f ^ n) \<langle>$\<rangle> a" "n < order f a"
    by (rule in_orbitE)
  then have "b = apply (inverse (inverse f) ^ n) a"
    by simp
  then have "b = apply (inverse (inverse f ^ n)) a"
    by (simp add: perm_power_inverse)
  then have "b = apply (inverse f ^ (n * (order (inverse f ^ n) a - 1))) a"
    by (simp add: apply_inverse_eq_apply_power_order_minus_one power_mult)
  then show "b \<in> orbit (inverse f) a"
    by simp
next
  fix b a
  assume "b \<in> orbit (inverse f) a"
  then show "b \<in> orbit f a"
    by (rule in_orbitE)
      (simp add: apply_inverse_eq_apply_power_order_minus_one
      perm_power_inverse power_mult [symmetric])
qed

lemma order_inverse [simp]:
  "order (inverse f) = order f"
  by (simp add: order_def)

lemma orbit_disjoint:
  assumes "orbit f a \<noteq> orbit f b"
  shows "orbit f a \<inter> orbit f b = {}"
proof (rule ccontr)
  assume "orbit f a \<inter> orbit f b \<noteq> {}"
  then obtain c where "c \<in> orbit f a \<inter> orbit f b"
    by blast
  then have "c \<in> orbit f a" and "c \<in> orbit f b"
    by auto
  then obtain m n where "c = (f ^ m) \<langle>$\<rangle> a"
    and "c = apply (f ^ n) b" by (blast elim!: in_orbitE)
  then have "(f ^ m) \<langle>$\<rangle> a = apply (f ^ n) b"
    by simp
  then have "apply (inverse f ^ m) ((f ^ m) \<langle>$\<rangle> a) =
    apply (inverse f ^ m) (apply (f ^ n) b)"
    by simp
  then have *: "apply (inverse f ^ m * f ^ n) b = a"
    by (simp add: apply_sequence perm_power_inverse)
  have "a \<in> orbit f b"
  proof (cases n m rule: linorder_cases)
    case equal with * show ?thesis
      by (simp add: perm_power_inverse)
  next
    case less
    moreover define q where "q = m - n"
    ultimately have "m = q + n" by arith
    with * have "apply (inverse f ^ q) b = a"
      by (simp add: power_add mult.assoc perm_power_inverse)
    then have "a \<in> orbit (inverse f) b"
      by (rule in_orbitI)
    then show ?thesis
      by simp
  next
    case greater
    moreover define q where "q = n - m"
    ultimately have "n = m + q" by arith
    with * have "apply (f ^ q) b = a"
      by (simp add: power_add mult.assoc [symmetric] perm_power_inverse)
    then show ?thesis
      by (rule in_orbitI)
  qed
  with assms show False
    by (auto dest: orbit_equiv)
qed

subsection \<open>Swaps\<close>

lift_definition swap :: "'a \<Rightarrow> 'a \<Rightarrow> 'a perm"  ("\<langle>_\<leftrightarrow>_\<rangle>")
  is "\<lambda>a b. Fun.swap a b id"
proof
  fix a b :: 'a
  have "{c. Fun.swap a b id c \<noteq> c} \<subseteq> {a, b}"
    by (auto simp add: Fun.swap_def)
  then show "finite {c. Fun.swap a b id c \<noteq> c}"
    by (rule finite_subset) simp
qed simp

lemma apply_swap_simp [simp]:
  "\<langle>a\<leftrightarrow>b\<rangle> \<langle>$\<rangle> a = b"
  "\<langle>a\<leftrightarrow>b\<rangle> \<langle>$\<rangle> b = a"
  by (transfer; simp)+

lemma apply_swap_same [simp]:
  "c \<noteq> a \<Longrightarrow> c \<noteq> b \<Longrightarrow> \<langle>a\<leftrightarrow>b\<rangle> \<langle>$\<rangle> c = c"
  by transfer simp

lemma apply_swap_eq_iff [simp]:
  "\<langle>a\<leftrightarrow>b\<rangle> \<langle>$\<rangle> c = a \<longleftrightarrow> c = b"
  "\<langle>a\<leftrightarrow>b\<rangle> \<langle>$\<rangle> c = b \<longleftrightarrow> c = a"
  by (transfer; auto simp add: Fun.swap_def)+

lemma swap_1 [simp]:
  "\<langle>a\<leftrightarrow>a\<rangle> = 1"
  by transfer simp

lemma swap_sym:
  "\<langle>b\<leftrightarrow>a\<rangle> = \<langle>a\<leftrightarrow>b\<rangle>"
  by (transfer; auto simp add: Fun.swap_def)+

lemma swap_self [simp]:
  "\<langle>a\<leftrightarrow>b\<rangle> * \<langle>a\<leftrightarrow>b\<rangle> = 1"
  by transfer (simp add: Fun.swap_def fun_eq_iff)

lemma affected_swap:
  "a \<noteq> b \<Longrightarrow> affected \<langle>a\<leftrightarrow>b\<rangle> = {a, b}"
  by transfer (auto simp add: Fun.swap_def)

lemma inverse_swap [simp]:
  "inverse \<langle>a\<leftrightarrow>b\<rangle> = \<langle>a\<leftrightarrow>b\<rangle>"
  by transfer (auto intro: inv_equality simp: Fun.swap_def)

subsection \<open>Permutations specified by cycles\<close>

fun cycle :: "'a list \<Rightarrow> 'a perm"  ("\<langle>_\<rangle>")
where
  "\<langle>[]\<rangle> = 1"
| "\<langle>[a]\<rangle> = 1"
| "\<langle>a # b # as\<rangle> = \<langle>a # as\<rangle> * \<langle>a\<leftrightarrow>b\<rangle>"

text \<open>
  We do not continue and restrict ourselves to syntax from here.
  See also introductory note.
\<close>

subsection \<open>Syntax\<close>

bundle no_permutation_syntax
begin
  no_notation swap    ("\<langle>_\<leftrightarrow>_\<rangle>")
  no_notation cycle   ("\<langle>_\<rangle>")
  no_notation "apply" (infixl "\<langle>$\<rangle>" 999)
end

bundle permutation_syntax
begin
  notation swap       ("\<langle>_\<leftrightarrow>_\<rangle>")
  notation cycle      ("\<langle>_\<rangle>")
  notation "apply"    (infixl "\<langle>$\<rangle>" 999)
end

unbundle no_permutation_syntax

end


(*  Title:      GCD2.thy
    Author:     Klaus Weidinger, TU Muenchen
    Copyright   2020

A simproc for the function "gcd (a::nat) (b::nat)" from "GCD.thy".
*)

theory GCD2
  imports
    Main
    Complex_Main
    "HOL-Computational_Algebra.Primes"
    "HOL-Number_Theory.Prime_Powers"
    HOL.Num
    Coprime
begin

text\<open>
Case distinction:
  case "a = 0 & b = 0": lemma 'gcd_0_0'
  case "a ~= 0 | b ~= 0": lemma 'gcd_eq'
\<close>

lemma gcd_eq:
  fixes a::nat and b::nat and s::nat and t::nat
  assumes "d * s = a" "d * t = b" "d > 0" "coprime s t"
  shows "gcd a b \<equiv> d"
proof -
  have "gcd (d * s) (d * t) = normalize (d * gcd s t)"
    by (auto simp: gcd_mult_left)
  hence "gcd a b = normalize (d * gcd s t)"
    using assms by simp
  hence "gcd a b = normalize d"
    using assms and coprime_iff_gcd_eq_1 by simp
  hence "gcd a b = d" using assms by simp
  thus "gcd a b \<equiv> d" by (simp add: eq_reflection)
qed

lemma gcd_0_0: "gcd (0::nat) (0::nat) \<equiv> 0"
  by simp

ML_file\<open>algorithms.ML\<close>
ML_file\<open>tools.ML\<close>

ML\<open>
signature GCD2 =
sig

val parse: Thm.cterm -> int * int

(*                            a     b     gcd    s     t      *)
datatype cert = GCD_CERT of (int * int) * int * int * int | ZERO_ZERO
val mk_cert: int -> int -> cert
val generate_proof: Proof.context -> cert -> thm option

val prove: Proof.context -> int * int -> thm option
val simproc: Proof.context -> Thm.cterm -> thm option

(* helper tools *)
val get_cert_numbers : cert -> (int * int)

end

structure Gcd2 : GCD2 =
struct

(*                            a     b     gcd    s     t      *)
datatype cert = GCD_CERT of (int * int) * int * int * int | ZERO_ZERO

fun parse ct = Tools.parse2 ct @{const_name "gcd"}

fun mk_cert a b =
    if (a = 0) andalso (b = 0) then ZERO_ZERO else
    let val gcd = Algorithms.euclid a b
    in
        GCD_CERT ((a, b), gcd, a div gcd, b div gcd)
    end

exception ERROR
fun generate_proof _ ZERO_ZERO =
        @{thm gcd_0_0}
            |> SOME
  | generate_proof ctxt (GCD_CERT ((a, b), gcd, s, t)) =
    let
      val coprime_s_t = case Coprime.prove_true ctxt (s, t) of SOME thm => thm |
                                                                   NONE => raise ERROR
    in
        @{thm gcd_eq}
            |> Drule.infer_instantiate' ctxt
                  (map (Tools.nat2ct' ctxt) [gcd, s, a, t, b])
            |> Tools.simp ctxt 3
            |> (fn thm => thm OF [coprime_s_t])
            |> SOME
    end

fun prove ctxt (a, b) =               (* (a, b)          *)
    (a,b) |-> mk_cert                 (* cert            *)
          |> generate_proof ctxt      (* thm option      *)
    handle ERROR => NONE

fun simproc ctxt input =            (* term            *)
    input |> parse                  (* n               *)
          |> prove ctxt             (* thm option      *)
    handle TERM _ => NONE

(* helper tools *)
fun get_cert_numbers ZERO_ZERO = (0, 0)
  | get_cert_numbers (GCD_CERT (ab, _, _, _)) = ab

end
\<close>

simproc_setup gcd_simproc ("gcd (numeral a::nat) (numeral b::nat)") = \<open>K Gcd2.simproc\<close>

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_relaxedprefix_is_prefix_2
imports "../../Test_Base"
begin

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

datatype It = A | B | C

fun x :: "'a list => 'a list => 'a list" where
"x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun isPrefix :: "It list => It list => bool" where
"isPrefix (nil2) z = True"
| "isPrefix (cons2 z2 x2) (nil2) = False"
| "isPrefix (cons2 z2 x2) (cons2 x3 x4) =
     ((z2 = x3) & (isPrefix x2 x4))"

fun isRelaxedPrefix :: "It list => It list => bool" where
"isRelaxedPrefix (nil2) z = True"
| "isRelaxedPrefix (cons2 z2 (nil2)) z = True"
| "isRelaxedPrefix (cons2 z2 (cons2 x3 x4)) (nil2) = False"
| "isRelaxedPrefix (cons2 z2 (cons2 x3 x4)) (cons2 x5 x6) =
     (if (z2 = x5) then isRelaxedPrefix (cons2 x3 x4) x6 else
        isPrefix (cons2 x3 x4) (cons2 x5 x6))"

theorem property0 :
  "isRelaxedPrefix (x xs (x (cons2 y (nil2)) ys)) (x xs (x ys zs))"
  oops

end


theory Chop_tmap
    imports Main "~~/src/HOL/Library/BNF_Corec" "$HIPSTER_HOME/IsaHipster"
begin

setup Tactic_Data.set_coinduct_sledgehammer

codatatype (lset: 'a) Llist =
    lnull: LNil
    | LCons (lhd: 'a) (ltl: "'a Llist")
where
 "ltl LNil = LNil"

codatatype 'a Tree = is_Leaf: Leaf |
           Node (left: "'a Tree") (val: 'a) (right: "'a Tree")
where
  "left Leaf = Leaf"
| "right Leaf = Leaf"

primcorec chop :: "'a Tree \<Rightarrow> 'a Tree"
where
  "is_Leaf t \<or> is_Leaf (left t) \<and> is_Leaf (right t) \<Longrightarrow> is_Leaf (chop t)"
| "val (chop t) = (if is_Leaf (left t) then val (right t) else val (left t))"
| "left (chop t) = (if is_Leaf (left t) then left (right t) else right t)"
| "right (chop t) = (if is_Leaf (left t) then right (right t) else chop (left t))"

primcorec llist_of :: "'a Tree \<Rightarrow> 'a Llist"
where
  "is_Leaf t \<Longrightarrow> lnull (llist_of t)"
| "lhd (llist_of t) = val t"
| "ltl (llist_of t) = llist_of (chop t)"

primcorec lmap :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a Llist \<Rightarrow> 'b Llist" where
 "lmap f xs = (case xs of LNil \<Rightarrow> LNil | LCons x xs \<Rightarrow> LCons (f x) (lmap f xs))"

primcorec tmap :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a Tree \<Rightarrow> 'a Tree"
  where "tmap f t = (case t of Leaf \<Rightarrow> Leaf
         | Node l x r \<Rightarrow> Node (tmap f l) (f x) (tmap f r))"
hipster chop tmap
lemma unknown [thy_expl]: "left (left (left y)) = Leaf"
  oops
why doesn't this return nicer things?
*)

(*hipster tmap*)
lemma lemma_a [thy_expl]: "tmap y (Node Leaf z Leaf) = Node Leaf (y z) Leaf"
  apply (coinduction  arbitrary: y z rule: Chop_tmap.Tree.coinduct_strong)
by simp

lemma lemma_aa [thy_expl]: "Node Leaf (y z) (tmap y x2) = tmap y (Node Leaf z x2)"
apply (coinduction  arbitrary: x2 y z rule: Chop_tmap.Tree.coinduct_strong)
by (simp_all add: tmap.ctr(1))

lemma lemma_ab [thy_expl]: "Node (tmap y z) (y x2) Leaf = tmap y (Node z x2 Leaf)"
apply (coinduction  arbitrary: x2 y z rule: Chop_tmap.Tree.coinduct_strong)
  by (simp_all add: tmap.ctr(1))

theorem chop_tmap: "chop (tmap f t) = tmap f (chop t)"
(*by hipster_coinduct_sledgehammer
Failed to apply initial proof method*)
end


theory prop_11

imports Main
        "$HIPSTER_HOME/IsaHipster"

begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"
fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
| "append (Cons2 z xs) y = Cons2 z (append xs y)"

fun rev :: "'a list => 'a list" where
  "rev (Nil2) = Nil2"
| "rev (Cons2 y xs) = append (rev xs) (Cons2 y (Nil2))"

hipster append rev

  theorem revAppend :
    "(rev (append (rev x) (rev y))) = (append y x)"
    by (hipster_induct_schemes append.simps rev.simps)

(*    by (hipster_induct_schemes rev.simps append.simps)*)

(*
lemma lemma_a [thy_expl]: "append x2 Nil2 = x2"
by (hipster_induct_schemes append.simps rev.simps list.exhaust)

lemma lemma_aa [thy_expl]: "append (append x1 y1) z1 =
append x1 (append y1 z1)"
by (hipster_induct_schemes append.simps rev.simps list.exhaust)

lemma lemma_ab [thy_expl]: "append (rev x4) (rev y4) =
rev (append y4 x4)"
by (hipster_induct_schemes append.simps rev.simps list.exhaust)

lemma lemma_ac [thy_expl]: "rev (rev x3) = x3"
by (hipster_induct_schemes append.simps rev.simps list.exhaust)
*)

(*by (tactic {* Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1 *})*)

end