(*  Authors:    Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb,
                Thomas M. Rasmussen, Jeremy Avigad, Tobias Nipkow

This file deals with the functions gcd and lcm.  Definitions and
lemmas are proved uniformly for the natural numbers and integers.

This file combines and revises a number of prior developments.

The original theories "GCD" and "Primes" were by Christophe Tabacznyj
and Lawrence C. Paulson, based on @{cite davenport92}. They introduced
gcd, lcm, and prime for the natural numbers.

The original theory "IntPrimes" was by Thomas M. Rasmussen, and
extended gcd, lcm, primes to the integers. Amine Chaieb provided
another extension of the notions to the integers, and added a number
of results to "Primes" and "GCD". IntPrimes also defined and developed
the congruence relations on the integers. The notion was extended to
the natural numbers by Chaieb.

Jeremy Avigad combined all of these, made everything uniform for the
natural numbers and the integers, and added a number of new theorems.

Tobias Nipkow cleaned up a lot.
*)

section {* Greatest common divisor and least common multiple *}

theory GCD
imports Fact
begin

declare One_nat_def [simp del]

subsection {* GCD and LCM definitions *}

class gcd = zero + one + dvd +
  fixes gcd :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
    and lcm :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
begin

abbreviation
  coprime :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
where
  "coprime x y == (gcd x y = 1)"

end

class semiring_gcd = comm_semiring_1 + gcd +
  assumes gcd_dvd1 [iff]: "gcd a b dvd a"
		and gcd_dvd2 [iff]: "gcd a b dvd b"
		and gcd_greatest: "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> c dvd gcd a b"

class ring_gcd = comm_ring_1 + semiring_gcd

instantiation nat :: gcd
begin

fun
  gcd_nat  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "gcd_nat x y =
   (if y = 0 then x else gcd y (x mod y))"

definition
  lcm_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "lcm_nat x y = x * y div (gcd x y)"

instance proof qed

end

instantiation int :: gcd
begin

definition
  gcd_int  :: "int \<Rightarrow> int \<Rightarrow> int"
where
  "gcd_int x y = int (gcd (nat (abs x)) (nat (abs y)))"

definition
  lcm_int :: "int \<Rightarrow> int \<Rightarrow> int"
where
  "lcm_int x y = int (lcm (nat (abs x)) (nat (abs y)))"

instance proof qed

end

subsection {* Transfer setup *}

lemma transfer_nat_int_gcd:
  "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> gcd (nat x) (nat y) = nat (gcd x y)"
  "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> lcm (nat x) (nat y) = nat (lcm x y)"
  unfolding gcd_int_def lcm_int_def
  by auto

lemma transfer_nat_int_gcd_closures:
  "x >= (0::int) \<Longrightarrow> y >= 0 \<Longrightarrow> gcd x y >= 0"
  "x >= (0::int) \<Longrightarrow> y >= 0 \<Longrightarrow> lcm x y >= 0"
  by (auto simp add: gcd_int_def lcm_int_def)

declare transfer_morphism_nat_int[transfer add return:
    transfer_nat_int_gcd transfer_nat_int_gcd_closures]

lemma transfer_int_nat_gcd:
  "gcd (int x) (int y) = int (gcd x y)"
  "lcm (int x) (int y) = int (lcm x y)"
  by (unfold gcd_int_def lcm_int_def, auto)

lemma transfer_int_nat_gcd_closures:
  "is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> gcd x y >= 0"
  "is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> lcm x y >= 0"
  by (auto simp add: gcd_int_def lcm_int_def)

declare transfer_morphism_int_nat[transfer add return:
    transfer_int_nat_gcd transfer_int_nat_gcd_closures]

subsection {* GCD properties *}

(* was gcd_induct *)
lemma gcd_nat_induct:
  fixes m n :: nat
  assumes "\<And>m. P m 0"
    and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
  shows "P m n"
  apply (rule gcd_nat.induct)
  apply (case_tac "y = 0")
  using assms apply simp_all
done

(* specific to int *)

lemma gcd_neg1_int [simp]: "gcd (-x::int) y = gcd x y"
  by (simp add: gcd_int_def)

lemma gcd_neg2_int [simp]: "gcd (x::int) (-y) = gcd x y"
  by (simp add: gcd_int_def)

lemma gcd_neg_numeral_1_int [simp]:
  "gcd (- numeral n :: int) x = gcd (numeral n) x"
  by (fact gcd_neg1_int)

lemma gcd_neg_numeral_2_int [simp]:
  "gcd x (- numeral n :: int) = gcd x (numeral n)"
  by (fact gcd_neg2_int)

lemma abs_gcd_int[simp]: "abs(gcd (x::int) y) = gcd x y"
by(simp add: gcd_int_def)

lemma gcd_abs_int: "gcd (x::int) y = gcd (abs x) (abs y)"
by (simp add: gcd_int_def)

lemma gcd_abs1_int[simp]: "gcd (abs x) (y::int) = gcd x y"
by (metis abs_idempotent gcd_abs_int)

lemma gcd_abs2_int[simp]: "gcd x (abs y::int) = gcd x y"
by (metis abs_idempotent gcd_abs_int)

lemma gcd_cases_int:
  fixes x :: int and y
  assumes "x >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> P (gcd x y)"
      and "x >= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> P (gcd x (-y))"
      and "x <= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> P (gcd (-x) y)"
      and "x <= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> P (gcd (-x) (-y))"
  shows "P (gcd x y)"
by (insert assms, auto, arith)

lemma gcd_ge_0_int [simp]: "gcd (x::int) y >= 0"
  by (simp add: gcd_int_def)

lemma lcm_neg1_int: "lcm (-x::int) y = lcm x y"
  by (simp add: lcm_int_def)

lemma lcm_neg2_int: "lcm (x::int) (-y) = lcm x y"
  by (simp add: lcm_int_def)

lemma lcm_abs_int: "lcm (x::int) y = lcm (abs x) (abs y)"
  by (simp add: lcm_int_def)

lemma abs_lcm_int [simp]: "abs (lcm i j::int) = lcm i j"
by(simp add:lcm_int_def)

lemma lcm_abs1_int[simp]: "lcm (abs x) (y::int) = lcm x y"
by (metis abs_idempotent lcm_int_def)

lemma lcm_abs2_int[simp]: "lcm x (abs y::int) = lcm x y"
by (metis abs_idempotent lcm_int_def)

lemma lcm_cases_int:
  fixes x :: int and y
  assumes "x >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> P (lcm x y)"
      and "x >= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> P (lcm x (-y))"
      and "x <= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> P (lcm (-x) y)"
      and "x <= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> P (lcm (-x) (-y))"
  shows "P (lcm x y)"
  using assms by (auto simp add: lcm_neg1_int lcm_neg2_int) arith

lemma lcm_ge_0_int [simp]: "lcm (x::int) y >= 0"
  by (simp add: lcm_int_def)

(* was gcd_0, etc. *)
lemma gcd_0_nat: "gcd (x::nat) 0 = x"
  by simp

(* was igcd_0, etc. *)
lemma gcd_0_int [simp]: "gcd (x::int) 0 = abs x"
  by (unfold gcd_int_def, auto)

lemma gcd_0_left_nat: "gcd 0 (x::nat) = x"
  by simp

lemma gcd_0_left_int [simp]: "gcd 0 (x::int) = abs x"
  by (unfold gcd_int_def, auto)

lemma gcd_red_nat: "gcd (x::nat) y = gcd y (x mod y)"
  by (case_tac "y = 0", auto)

(* weaker, but useful for the simplifier *)

lemma gcd_non_0_nat: "y ~= (0::nat) \<Longrightarrow> gcd (x::nat) y = gcd y (x mod y)"
  by simp

lemma gcd_1_nat [simp]: "gcd (m::nat) 1 = 1"
  by simp

lemma gcd_Suc_0 [simp]: "gcd (m::nat) (Suc 0) = Suc 0"
  by (simp add: One_nat_def)

lemma gcd_1_int [simp]: "gcd (m::int) 1 = 1"
  by (simp add: gcd_int_def)

lemma gcd_idem_nat: "gcd (x::nat) x = x"
by simp

lemma gcd_idem_int: "gcd (x::int) x = abs x"
by (auto simp add: gcd_int_def)

declare gcd_nat.simps [simp del]

text {*
  \medskip @{term "gcd m n"} divides @{text m} and @{text n}.  The
  conjunctions don't seem provable separately.
*}

instance nat :: semiring_gcd
proof
  fix m n :: nat
  show "gcd m n dvd m" and "gcd m n dvd n"
  proof (induct m n rule: gcd_nat_induct)
    fix m n :: nat
    assume "gcd n (m mod n) dvd m mod n" and "gcd n (m mod n) dvd n"
    then have "gcd n (m mod n) dvd m"
      by (rule dvd_mod_imp_dvd)
    moreover assume "0 < n"
    ultimately show "gcd m n dvd m"
      by (simp add: gcd_non_0_nat)
  qed (simp_all add: gcd_0_nat gcd_non_0_nat)
next
  fix m n k :: nat
  assume "k dvd m" and "k dvd n"
  then show "k dvd gcd m n"
    by (induct m n rule: gcd_nat_induct) (simp_all add: gcd_non_0_nat dvd_mod gcd_0_nat)
qed

instance int :: ring_gcd
  by intro_classes (simp_all add: dvd_int_unfold_dvd_nat gcd_int_def gcd_greatest)

lemma dvd_gcd_D1_nat: "k dvd gcd m n \<Longrightarrow> (k::nat) dvd m"
  by (metis gcd_dvd1 dvd_trans)

lemma dvd_gcd_D2_nat: "k dvd gcd m n \<Longrightarrow> (k::nat) dvd n"
  by (metis gcd_dvd2 dvd_trans)

lemma dvd_gcd_D1_int: "i dvd gcd m n \<Longrightarrow> (i::int) dvd m"
  by (metis gcd_dvd1 dvd_trans)

lemma dvd_gcd_D2_int: "i dvd gcd m n \<Longrightarrow> (i::int) dvd n"
  by (metis gcd_dvd2 dvd_trans)

lemma gcd_le1_nat [simp]: "a \<noteq> 0 \<Longrightarrow> gcd (a::nat) b \<le> a"
  by (rule dvd_imp_le, auto)

lemma gcd_le2_nat [simp]: "b \<noteq> 0 \<Longrightarrow> gcd (a::nat) b \<le> b"
  by (rule dvd_imp_le, auto)

lemma gcd_le1_int [simp]: "a > 0 \<Longrightarrow> gcd (a::int) b \<le> a"
  by (rule zdvd_imp_le, auto)

lemma gcd_le2_int [simp]: "b > 0 \<Longrightarrow> gcd (a::int) b \<le> b"
  by (rule zdvd_imp_le, auto)

lemma gcd_greatest_iff_nat [iff]: "(k dvd gcd (m::nat) n) =
    (k dvd m & k dvd n)"
  by (blast intro!: gcd_greatest intro: dvd_trans)

lemma gcd_greatest_iff_int: "((k::int) dvd gcd m n) = (k dvd m & k dvd n)"
  by (blast intro!: gcd_greatest intro: dvd_trans)

lemma gcd_zero_nat [simp]: "(gcd (m::nat) n = 0) = (m = 0 & n = 0)"
  by (simp only: dvd_0_left_iff [symmetric] gcd_greatest_iff_nat)

lemma gcd_zero_int [simp]: "(gcd (m::int) n = 0) = (m = 0 & n = 0)"
  by (auto simp add: gcd_int_def)

lemma gcd_pos_nat [simp]: "(gcd (m::nat) n > 0) = (m ~= 0 | n ~= 0)"
  by (insert gcd_zero_nat [of m n], arith)

lemma gcd_pos_int [simp]: "(gcd (m::int) n > 0) = (m ~= 0 | n ~= 0)"
  by (insert gcd_zero_int [of m n], insert gcd_ge_0_int [of m n], arith)

lemma gcd_unique_nat: "(d::nat) dvd a \<and> d dvd b \<and>
    (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
  apply auto
  apply (rule dvd_antisym)
  apply (erule (1) gcd_greatest)
  apply auto
done

lemma gcd_unique_int: "d >= 0 & (d::int) dvd a \<and> d dvd b \<and>
    (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
apply (case_tac "d = 0")
 apply simp
apply (rule iffI)
 apply (rule zdvd_antisym_nonneg)
 apply (auto intro: gcd_greatest)
done

interpretation gcd_nat: abel_semigroup "gcd :: nat \<Rightarrow> nat \<Rightarrow> nat"
  + gcd_nat: semilattice_neutr_order "gcd :: nat \<Rightarrow> nat \<Rightarrow> nat" 0 "op dvd" "(\<lambda>m n. m dvd n \<and> \<not> n dvd m)"
apply default
apply (auto intro: dvd_antisym dvd_trans)[4]
apply (metis dvd.dual_order.refl gcd_unique_nat)
apply (auto intro: dvdI elim: dvdE)
done

interpretation gcd_int: abel_semigroup "gcd :: int \<Rightarrow> int \<Rightarrow> int"
proof
qed (simp_all add: gcd_int_def gcd_nat.assoc gcd_nat.commute gcd_nat.left_commute)

lemmas gcd_assoc_nat = gcd_nat.assoc
lemmas gcd_commute_nat = gcd_nat.commute
lemmas gcd_left_commute_nat = gcd_nat.left_commute
lemmas gcd_assoc_int = gcd_int.assoc
lemmas gcd_commute_int = gcd_int.commute
lemmas gcd_left_commute_int = gcd_int.left_commute

lemmas gcd_ac_nat = gcd_assoc_nat gcd_commute_nat gcd_left_commute_nat

lemmas gcd_ac_int = gcd_assoc_int gcd_commute_int gcd_left_commute_int

lemma gcd_proj1_if_dvd_nat [simp]: "(x::nat) dvd y \<Longrightarrow> gcd x y = x"
  by (fact gcd_nat.absorb1)

lemma gcd_proj2_if_dvd_nat [simp]: "(y::nat) dvd x \<Longrightarrow> gcd x y = y"
  by (fact gcd_nat.absorb2)

lemma gcd_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> gcd (x::int) y = abs x"
  by (metis abs_dvd_iff gcd_0_left_int gcd_abs_int gcd_unique_int)

lemma gcd_proj2_if_dvd_int [simp]: "y dvd x \<Longrightarrow> gcd (x::int) y = abs y"
  by (metis gcd_proj1_if_dvd_int gcd_commute_int)

text {*
  \medskip Multiplication laws
*}

lemma gcd_mult_distrib_nat: "(k::nat) * gcd m n = gcd (k * m) (k * n)"
    -- {* @{cite \<open>page 27\<close> davenport92} *}
  apply (induct m n rule: gcd_nat_induct)
  apply simp
  apply (case_tac "k = 0")
  apply (simp_all add: gcd_non_0_nat)
done

lemma gcd_mult_distrib_int: "abs (k::int) * gcd m n = gcd (k * m) (k * n)"
  apply (subst (1 2) gcd_abs_int)
  apply (subst (1 2) abs_mult)
  apply (rule gcd_mult_distrib_nat [transferred])
  apply auto
done

lemma coprime_dvd_mult_nat: "coprime (k::nat) n \<Longrightarrow> k dvd m * n \<Longrightarrow> k dvd m"
  apply (insert gcd_mult_distrib_nat [of m k n])
  apply simp
  apply (erule_tac t = m in ssubst)
  apply simp
  done

lemma coprime_dvd_mult_int:
  "coprime (k::int) n \<Longrightarrow> k dvd m * n \<Longrightarrow> k dvd m"
apply (subst abs_dvd_iff [symmetric])
apply (subst dvd_abs_iff [symmetric])
apply (subst (asm) gcd_abs_int)
apply (rule coprime_dvd_mult_nat [transferred])
    prefer 4 apply assumption
   apply auto
apply (subst abs_mult [symmetric], auto)
done

lemma coprime_dvd_mult_iff_nat: "coprime (k::nat) n \<Longrightarrow>
    (k dvd m * n) = (k dvd m)"
  by (auto intro: coprime_dvd_mult_nat)

lemma coprime_dvd_mult_iff_int: "coprime (k::int) n \<Longrightarrow>
    (k dvd m * n) = (k dvd m)"
  by (auto intro: coprime_dvd_mult_int)

lemma gcd_mult_cancel_nat: "coprime k n \<Longrightarrow> gcd ((k::nat) * m) n = gcd m n"
  apply (rule dvd_antisym)
  apply (rule gcd_greatest)
  apply (rule_tac n = k in coprime_dvd_mult_nat)
  apply (simp add: gcd_assoc_nat)
  apply (simp add: gcd_commute_nat)
  apply (simp_all add: mult.commute)
done

lemma gcd_mult_cancel_int:
  "coprime (k::int) n \<Longrightarrow> gcd (k * m) n = gcd m n"
apply (subst (1 2) gcd_abs_int)
apply (subst abs_mult)
apply (rule gcd_mult_cancel_nat [transferred], auto)
done

lemma coprime_crossproduct_nat:
  fixes a b c d :: nat
  assumes "coprime a d" and "coprime b c"
  shows "a * c = b * d \<longleftrightarrow> a = b \<and> c = d" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?rhs then show ?lhs by simp
next
  assume ?lhs
  from `?lhs` have "a dvd b * d" by (auto intro: dvdI dest: sym)
  with `coprime a d` have "a dvd b" by (simp add: coprime_dvd_mult_iff_nat)
  from `?lhs` have "b dvd a * c" by (auto intro: dvdI dest: sym)
  with `coprime b c` have "b dvd a" by (simp add: coprime_dvd_mult_iff_nat)
  from `?lhs` have "c dvd d * b" by (auto intro: dvdI dest: sym simp add: mult.commute)
  with `coprime b c` have "c dvd d" by (simp add: coprime_dvd_mult_iff_nat gcd_commute_nat)
  from `?lhs` have "d dvd c * a" by (auto intro: dvdI dest: sym simp add: mult.commute)
  with `coprime a d` have "d dvd c" by (simp add: coprime_dvd_mult_iff_nat gcd_commute_nat)
  from `a dvd b` `b dvd a` have "a = b" by (rule Nat.dvd.antisym)
  moreover from `c dvd d` `d dvd c` have "c = d" by (rule Nat.dvd.antisym)
  ultimately show ?rhs ..
qed

lemma coprime_crossproduct_int:
  fixes a b c d :: int
  assumes "coprime a d" and "coprime b c"
  shows "\<bar>a\<bar> * \<bar>c\<bar> = \<bar>b\<bar> * \<bar>d\<bar> \<longleftrightarrow> \<bar>a\<bar> = \<bar>b\<bar> \<and> \<bar>c\<bar> = \<bar>d\<bar>"
  using assms by (intro coprime_crossproduct_nat [transferred]) auto

text {* \medskip Addition laws *}

lemma gcd_add1_nat [simp]: "gcd ((m::nat) + n) n = gcd m n"
  apply (case_tac "n = 0")
  apply (simp_all add: gcd_non_0_nat)
done

lemma gcd_add2_nat [simp]: "gcd (m::nat) (m + n) = gcd m n"
  apply (subst (1 2) gcd_commute_nat)
  apply (subst add.commute)
  apply simp
done

(* to do: add the other variations? *)

lemma gcd_diff1_nat: "(m::nat) >= n \<Longrightarrow> gcd (m - n) n = gcd m n"
  by (subst gcd_add1_nat [symmetric], auto)

lemma gcd_diff2_nat: "(n::nat) >= m \<Longrightarrow> gcd (n - m) n = gcd m n"
  apply (subst gcd_commute_nat)
  apply (subst gcd_diff1_nat [symmetric])
  apply auto
  apply (subst gcd_commute_nat)
  apply (subst gcd_diff1_nat)
  apply assumption
  apply (rule gcd_commute_nat)
done

lemma gcd_non_0_int: "(y::int) > 0 \<Longrightarrow> gcd x y = gcd y (x mod y)"
  apply (frule_tac b = y and a = x in pos_mod_sign)
  apply (simp del: pos_mod_sign add: gcd_int_def abs_if nat_mod_distrib)
  apply (auto simp add: gcd_non_0_nat nat_mod_distrib [symmetric]
    zmod_zminus1_eq_if)
  apply (frule_tac a = x in pos_mod_bound)
  apply (subst (1 2) gcd_commute_nat)
  apply (simp del: pos_mod_bound add: nat_diff_distrib gcd_diff2_nat
    nat_le_eq_zle)
done

lemma gcd_red_int: "gcd (x::int) y = gcd y (x mod y)"
  apply (case_tac "y = 0")
  apply force
  apply (case_tac "y > 0")
  apply (subst gcd_non_0_int, auto)
  apply (insert gcd_non_0_int [of "-y" "-x"])
  apply auto
done

lemma gcd_add1_int [simp]: "gcd ((m::int) + n) n = gcd m n"
by (metis gcd_red_int mod_add_self1 add.commute)

lemma gcd_add2_int [simp]: "gcd m ((m::int) + n) = gcd m n"
by (metis gcd_add1_int gcd_commute_int add.commute)

lemma gcd_add_mult_nat: "gcd (m::nat) (k * m + n) = gcd m n"
by (metis mod_mult_self3 gcd_commute_nat gcd_red_nat)

lemma gcd_add_mult_int: "gcd (m::int) (k * m + n) = gcd m n"
by (metis gcd_commute_int gcd_red_int mod_mult_self1 add.commute)

(* to do: differences, and all variations of addition rules
    as simplification rules for nat and int *)

(* FIXME remove iff *)
lemma gcd_dvd_prod_nat [iff]: "gcd (m::nat) n dvd k * n"
  using mult_dvd_mono [of 1] by auto

(* to do: add the three variations of these, and for ints? *)

lemma finite_divisors_nat[simp]:
  assumes "(m::nat) ~= 0" shows "finite{d. d dvd m}"
proof-
  have "finite{d. d <= m}" by(blast intro: bounded_nat_set_is_finite)
  from finite_subset[OF _ this] show ?thesis using assms
    by(bestsimp intro!:dvd_imp_le)
qed

lemma finite_divisors_int[simp]:
  assumes "(i::int) ~= 0" shows "finite{d. d dvd i}"
proof-
  have "{d. abs d <= abs i} = {- abs i .. abs i}" by(auto simp:abs_if)
  hence "finite{d. abs d <= abs i}" by simp
  from finite_subset[OF _ this] show ?thesis using assms
    by(bestsimp intro!:dvd_imp_le_int)
qed

lemma Max_divisors_self_nat[simp]: "n\<noteq>0 \<Longrightarrow> Max{d::nat. d dvd n} = n"
apply(rule antisym)
 apply (fastforce intro: Max_le_iff[THEN iffD2] simp: dvd_imp_le)
apply simp
done

lemma Max_divisors_self_int[simp]: "n\<noteq>0 \<Longrightarrow> Max{d::int. d dvd n} = abs n"
apply(rule antisym)
 apply(rule Max_le_iff [THEN iffD2])
  apply (auto intro: abs_le_D1 dvd_imp_le_int)
done

lemma gcd_is_Max_divisors_nat:
  "m ~= 0 \<Longrightarrow> n ~= 0 \<Longrightarrow> gcd (m::nat) n = (Max {d. d dvd m & d dvd n})"
apply(rule Max_eqI[THEN sym])
  apply (metis finite_Collect_conjI finite_divisors_nat)
 apply simp
 apply(metis Suc_diff_1 Suc_neq_Zero dvd_imp_le gcd_greatest_iff_nat gcd_pos_nat)
apply simp
done

lemma gcd_is_Max_divisors_int:
  "m ~= 0 ==> n ~= 0 ==> gcd (m::int) n = (Max {d. d dvd m & d dvd n})"
apply(rule Max_eqI[THEN sym])
  apply (metis finite_Collect_conjI finite_divisors_int)
 apply simp
 apply (metis gcd_greatest_iff_int gcd_pos_int zdvd_imp_le)
apply simp
done

lemma gcd_code_int [code]:
  "gcd k l = \<bar>if l = (0::int) then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
  by (simp add: gcd_int_def nat_mod_distrib gcd_non_0_nat)

subsection {* Coprimality *}

lemma div_gcd_coprime_nat:
  assumes nz: "(a::nat) \<noteq> 0 \<or> b \<noteq> 0"
  shows "coprime (a div gcd a b) (b div gcd a b)"
proof -
  let ?g = "gcd a b"
  let ?a' = "a div ?g"
  let ?b' = "b div ?g"
  let ?g' = "gcd ?a' ?b'"
  have dvdg: "?g dvd a" "?g dvd b" by simp_all
  have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by simp_all
  from dvdg dvdg' obtain ka kb ka' kb' where
      kab: "a = ?g * ka" "b = ?g * kb" "?a' = ?g' * ka'" "?b' = ?g' * kb'"
    unfolding dvd_def by blast
  from this [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
    by (simp_all add: mult.assoc mult.left_commute [of "gcd a b"])
  then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
    by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)]
      dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
  have "?g \<noteq> 0" using nz by simp
  then have gp: "?g > 0" by arith
  from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
  with dvd_mult_cancel1 [OF gp] show "?g' = 1" by simp
qed

lemma div_gcd_coprime_int:
  assumes nz: "(a::int) \<noteq> 0 \<or> b \<noteq> 0"
  shows "coprime (a div gcd a b) (b div gcd a b)"
apply (subst (1 2 3) gcd_abs_int)
apply (subst (1 2) abs_div)
  apply simp
 apply simp
apply(subst (1 2) abs_gcd_int)
apply (rule div_gcd_coprime_nat [transferred])
using nz apply (auto simp add: gcd_abs_int [symmetric])
done

lemma coprime_nat: "coprime (a::nat) b \<longleftrightarrow> (\<forall>d. d dvd a \<and> d dvd b \<longleftrightarrow> d = 1)"
  using gcd_unique_nat[of 1 a b, simplified] by auto

lemma coprime_Suc_0_nat:
    "coprime (a::nat) b \<longleftrightarrow> (\<forall>d. d dvd a \<and> d dvd b \<longleftrightarrow> d = Suc 0)"
  using coprime_nat by (simp add: One_nat_def)

lemma coprime_int: "coprime (a::int) b \<longleftrightarrow>
    (\<forall>d. d >= 0 \<and> d dvd a \<and> d dvd b \<longleftrightarrow> d = 1)"
  using gcd_unique_int [of 1 a b]
  apply clarsimp
  apply (erule subst)
  apply (rule iffI)
  apply force
  apply (drule_tac x = "abs ?e" in exI)
  apply (case_tac "(?e::int) >= 0")
  apply force
  apply force
done

lemma gcd_coprime_nat:
  assumes z: "gcd (a::nat) b \<noteq> 0" and a: "a = a' * gcd a b" and
    b: "b = b' * gcd a b"
  shows    "coprime a' b'"

  apply (subgoal_tac "a' = a div gcd a b")
  apply (erule ssubst)
  apply (subgoal_tac "b' = b div gcd a b")
  apply (erule ssubst)
  apply (rule div_gcd_coprime_nat)
  using z apply force
  apply (subst (1) b)
  using z apply force
  apply (subst (1) a)
  using z apply force
  done

lemma gcd_coprime_int:
  assumes z: "gcd (a::int) b \<noteq> 0" and a: "a = a' * gcd a b" and
    b: "b = b' * gcd a b"
  shows    "coprime a' b'"

  apply (subgoal_tac "a' = a div gcd a b")
  apply (erule ssubst)
  apply (subgoal_tac "b' = b div gcd a b")
  apply (erule ssubst)
  apply (rule div_gcd_coprime_int)
  using z apply force
  apply (subst (1) b)
  using z apply force
  apply (subst (1) a)
  using z apply force
  done

lemma coprime_mult_nat: assumes da: "coprime (d::nat) a" and db: "coprime d b"
    shows "coprime d (a * b)"
  apply (subst gcd_commute_nat)
  using da apply (subst gcd_mult_cancel_nat)
  apply (subst gcd_commute_nat, assumption)
  apply (subst gcd_commute_nat, rule db)
done

lemma coprime_mult_int: assumes da: "coprime (d::int) a" and db: "coprime d b"
    shows "coprime d (a * b)"
  apply (subst gcd_commute_int)
  using da apply (subst gcd_mult_cancel_int)
  apply (subst gcd_commute_int, assumption)
  apply (subst gcd_commute_int, rule db)
done

lemma coprime_lmult_nat:
  assumes dab: "coprime (d::nat) (a * b)" shows "coprime d a"
proof -
  have "gcd d a dvd gcd d (a * b)"
    by (rule gcd_greatest, auto)
  with dab show ?thesis
    by auto
qed

lemma coprime_lmult_int:
  assumes "coprime (d::int) (a * b)" shows "coprime d a"
proof -
  have "gcd d a dvd gcd d (a * b)"
    by (rule gcd_greatest, auto)
  with assms show ?thesis
    by auto
qed

lemma coprime_rmult_nat:
  assumes "coprime (d::nat) (a * b)" shows "coprime d b"
proof -
  have "gcd d b dvd gcd d (a * b)"
    by (rule gcd_greatest, auto intro: dvd_mult)
  with assms show ?thesis
    by auto
qed

lemma coprime_rmult_int:
  assumes dab: "coprime (d::int) (a * b)" shows "coprime d b"
proof -
  have "gcd d b dvd gcd d (a * b)"
    by (rule gcd_greatest, auto intro: dvd_mult)
  with dab show ?thesis
    by auto
qed

lemma coprime_mul_eq_nat: "coprime (d::nat) (a * b) \<longleftrightarrow>
    coprime d a \<and>  coprime d b"
  using coprime_rmult_nat[of d a b] coprime_lmult_nat[of d a b]
    coprime_mult_nat[of d a b]
  by blast

lemma coprime_mul_eq_int: "coprime (d::int) (a * b) \<longleftrightarrow>
    coprime d a \<and>  coprime d b"
  using coprime_rmult_int[of d a b] coprime_lmult_int[of d a b]
    coprime_mult_int[of d a b]
  by blast

lemma coprime_power_int:
  assumes "0 < n" shows "coprime (a :: int) (b ^ n) \<longleftrightarrow> coprime a b"
  using assms
proof (induct n)
  case (Suc n) then show ?case
    by (cases n) (simp_all add: coprime_mul_eq_int)
qed simp

lemma gcd_coprime_exists_nat:
    assumes nz: "gcd (a::nat) b \<noteq> 0"
    shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
  apply (rule_tac x = "a div gcd a b" in exI)
  apply (rule_tac x = "b div gcd a b" in exI)
  using nz apply (auto simp add: div_gcd_coprime_nat dvd_div_mult)
done

lemma gcd_coprime_exists_int:
    assumes nz: "gcd (a::int) b \<noteq> 0"
    shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
  apply (rule_tac x = "a div gcd a b" in exI)
  apply (rule_tac x = "b div gcd a b" in exI)
  using nz apply (auto simp add: div_gcd_coprime_int)
done

lemma coprime_exp_nat: "coprime (d::nat) a \<Longrightarrow> coprime d (a^n)"
  by (induct n, simp_all add: coprime_mult_nat)

lemma coprime_exp_int: "coprime (d::int) a \<Longrightarrow> coprime d (a^n)"
  by (induct n, simp_all add: coprime_mult_int)

lemma coprime_exp2_nat [intro]: "coprime (a::nat) b \<Longrightarrow> coprime (a^n) (b^m)"
  apply (rule coprime_exp_nat)
  apply (subst gcd_commute_nat)
  apply (rule coprime_exp_nat)
  apply (subst gcd_commute_nat, assumption)
done

lemma coprime_exp2_int [intro]: "coprime (a::int) b \<Longrightarrow> coprime (a^n) (b^m)"
  apply (rule coprime_exp_int)
  apply (subst gcd_commute_int)
  apply (rule coprime_exp_int)
  apply (subst gcd_commute_int, assumption)
done

lemma gcd_exp_nat: "gcd ((a::nat)^n) (b^n) = (gcd a b)^n"
proof (cases)
  assume "a = 0 & b = 0"
  thus ?thesis by simp
  next assume "~(a = 0 & b = 0)"
  hence "coprime ((a div gcd a b)^n) ((b div gcd a b)^n)"
    by (auto simp:div_gcd_coprime_nat)
  hence "gcd ((a div gcd a b)^n * (gcd a b)^n)
      ((b div gcd a b)^n * (gcd a b)^n) = (gcd a b)^n"
    apply (subst (1 2) mult.commute)
    apply (subst gcd_mult_distrib_nat [symmetric])
    apply simp
    done
  also have "(a div gcd a b)^n * (gcd a b)^n = a^n"
    apply (subst div_power)
    apply auto
    apply (rule dvd_div_mult_self)
    apply (rule dvd_power_same)
    apply auto
    done
  also have "(b div gcd a b)^n * (gcd a b)^n = b^n"
    apply (subst div_power)
    apply auto
    apply (rule dvd_div_mult_self)
    apply (rule dvd_power_same)
    apply auto
    done
  finally show ?thesis .
qed

lemma gcd_exp_int: "gcd ((a::int)^n) (b^n) = (gcd a b)^n"
  apply (subst (1 2) gcd_abs_int)
  apply (subst (1 2) power_abs)
  apply (rule gcd_exp_nat [where n = n, transferred])
  apply auto
done

lemma division_decomp_nat: assumes dc: "(a::nat) dvd b * c"
  shows "\<exists>b' c'. a = b' * c' \<and> b' dvd b \<and> c' dvd c"
proof-
  let ?g = "gcd a b"
  {assume "?g = 0" with dc have ?thesis by auto}
  moreover
  {assume z: "?g \<noteq> 0"
    from gcd_coprime_exists_nat[OF z]
    obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'"
      by blast
    have thb: "?g dvd b" by auto
    from ab'(1) have "a' dvd a"  unfolding dvd_def by blast
    with dc have th0: "a' dvd b*c" using dvd_trans[of a' a "b*c"] by simp
    from dc ab'(1,2) have "a'*?g dvd (b'*?g) *c" by auto
    hence "?g*a' dvd ?g * (b' * c)" by (simp add: mult.assoc)
    with z have th_1: "a' dvd b' * c" by auto
    from coprime_dvd_mult_nat[OF ab'(3)] th_1
    have thc: "a' dvd c" by (subst (asm) mult.commute, blast)
    from ab' have "a = ?g*a'" by algebra
    with thb thc have ?thesis by blast }
  ultimately show ?thesis by blast
qed

lemma division_decomp_int: assumes dc: "(a::int) dvd b * c"
  shows "\<exists>b' c'. a = b' * c' \<and> b' dvd b \<and> c' dvd c"
proof-
  let ?g = "gcd a b"
  {assume "?g = 0" with dc have ?thesis by auto}
  moreover
  {assume z: "?g \<noteq> 0"
    from gcd_coprime_exists_int[OF z]
    obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'"
      by blast
    have thb: "?g dvd b" by auto
    from ab'(1) have "a' dvd a"  unfolding dvd_def by blast
    with dc have th0: "a' dvd b*c"
      using dvd_trans[of a' a "b*c"] by simp
    from dc ab'(1,2) have "a'*?g dvd (b'*?g) *c" by auto
    hence "?g*a' dvd ?g * (b' * c)" by (simp add: mult.assoc)
    with z have th_1: "a' dvd b' * c" by auto
    from coprime_dvd_mult_int[OF ab'(3)] th_1
    have thc: "a' dvd c" by (subst (asm) mult.commute, blast)
    from ab' have "a = ?g*a'" by algebra
    with thb thc have ?thesis by blast }
  ultimately show ?thesis by blast
qed

lemma pow_divides_pow_nat:
  assumes ab: "(a::nat) ^ n dvd b ^n" and n:"n \<noteq> 0"
  shows "a dvd b"
proof-
  let ?g = "gcd a b"
  from n obtain m where m: "n = Suc m" by (cases n, simp_all)
  {assume "?g = 0" with ab n have ?thesis by auto }
  moreover
  {assume z: "?g \<noteq> 0"
    hence zn: "?g ^ n \<noteq> 0" using n by simp
    from gcd_coprime_exists_nat[OF z]
    obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'"
      by blast
    from ab have "(a' * ?g) ^ n dvd (b' * ?g)^n"
      by (simp add: ab'(1,2)[symmetric])
    hence "?g^n*a'^n dvd ?g^n *b'^n"
      by (simp only: power_mult_distrib mult.commute)
    then have th0: "a'^n dvd b'^n"
      using zn by auto
    have "a' dvd a'^n" by (simp add: m)
    with th0 have "a' dvd b'^n" using dvd_trans[of a' "a'^n" "b'^n"] by simp
    hence th1: "a' dvd b'^m * b'" by (simp add: m mult.commute)
    from coprime_dvd_mult_nat[OF coprime_exp_nat [OF ab'(3), of m]] th1
    have "a' dvd b'" by (subst (asm) mult.commute, blast)
    hence "a'*?g dvd b'*?g" by simp
    with ab'(1,2)  have ?thesis by simp }
  ultimately show ?thesis by blast
qed

lemma pow_divides_pow_int:
  assumes ab: "(a::int) ^ n dvd b ^n" and n:"n \<noteq> 0"
  shows "a dvd b"
proof-
  let ?g = "gcd a b"
  from n obtain m where m: "n = Suc m" by (cases n, simp_all)
  {assume "?g = 0" with ab n have ?thesis by auto }
  moreover
  {assume z: "?g \<noteq> 0"
    hence zn: "?g ^ n \<noteq> 0" using n by simp
    from gcd_coprime_exists_int[OF z]
    obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'"
      by blast
    from ab have "(a' * ?g) ^ n dvd (b' * ?g)^n"
      by (simp add: ab'(1,2)[symmetric])
    hence "?g^n*a'^n dvd ?g^n *b'^n"
      by (simp only: power_mult_distrib mult.commute)
    with zn z n have th0:"a'^n dvd b'^n" by auto
    have "a' dvd a'^n" by (simp add: m)
    with th0 have "a' dvd b'^n"
      using dvd_trans[of a' "a'^n" "b'^n"] by simp
    hence th1: "a' dvd b'^m * b'" by (simp add: m mult.commute)
    from coprime_dvd_mult_int[OF coprime_exp_int [OF ab'(3), of m]] th1
    have "a' dvd b'" by (subst (asm) mult.commute, blast)
    hence "a'*?g dvd b'*?g" by simp
    with ab'(1,2)  have ?thesis by simp }
  ultimately show ?thesis by blast
qed

lemma pow_divides_eq_nat [simp]: "n ~= 0 \<Longrightarrow> ((a::nat)^n dvd b^n) = (a dvd b)"
  by (auto intro: pow_divides_pow_nat dvd_power_same)

lemma pow_divides_eq_int [simp]: "n ~= 0 \<Longrightarrow> ((a::int)^n dvd b^n) = (a dvd b)"
  by (auto intro: pow_divides_pow_int dvd_power_same)

lemma divides_mult_nat:
  assumes mr: "(m::nat) dvd r" and nr: "n dvd r" and mn:"coprime m n"
  shows "m * n dvd r"
proof-
  from mr nr obtain m' n' where m': "r = m*m'" and n': "r = n*n'"
    unfolding dvd_def by blast
  from mr n' have "m dvd n'*n" by (simp add: mult.commute)
  hence "m dvd n'" using coprime_dvd_mult_iff_nat[OF mn] by simp
  then obtain k where k: "n' = m*k" unfolding dvd_def by blast
  from n' k show ?thesis unfolding dvd_def by auto
qed

lemma divides_mult_int:
  assumes mr: "(m::int) dvd r" and nr: "n dvd r" and mn:"coprime m n"
  shows "m * n dvd r"
proof-
  from mr nr obtain m' n' where m': "r = m*m'" and n': "r = n*n'"
    unfolding dvd_def by blast
  from mr n' have "m dvd n'*n" by (simp add: mult.commute)
  hence "m dvd n'" using coprime_dvd_mult_iff_int[OF mn] by simp
  then obtain k where k: "n' = m*k" unfolding dvd_def by blast
  from n' k show ?thesis unfolding dvd_def by auto
qed

lemma coprime_plus_one_nat [simp]: "coprime ((n::nat) + 1) n"
  apply (subgoal_tac "gcd (n + 1) n dvd (n + 1 - n)")
  apply force
  apply (rule dvd_diff_nat)
  apply auto
done

lemma coprime_Suc_nat [simp]: "coprime (Suc n) n"
  using coprime_plus_one_nat by (simp add: One_nat_def)

lemma coprime_plus_one_int [simp]: "coprime ((n::int) + 1) n"
  apply (subgoal_tac "gcd (n + 1) n dvd (n + 1 - n)")
  apply force
  apply (rule dvd_diff)
  apply auto
done

lemma coprime_minus_one_nat: "(n::nat) \<noteq> 0 \<Longrightarrow> coprime (n - 1) n"
  using coprime_plus_one_nat [of "n - 1"]
    gcd_commute_nat [of "n - 1" n] by auto

lemma coprime_minus_one_int: "coprime ((n::int) - 1) n"
  using coprime_plus_one_int [of "n - 1"]
    gcd_commute_int [of "n - 1" n] by auto

lemma setprod_coprime_nat [rule_format]:
    "(ALL i: A. coprime (f i) (x::nat)) --> coprime (PROD i:A. f i) x"
  apply (case_tac "finite A")
  apply (induct set: finite)
  apply (auto simp add: gcd_mult_cancel_nat)
done

lemma setprod_coprime_int [rule_format]:
    "(ALL i: A. coprime (f i) (x::int)) --> coprime (PROD i:A. f i) x"
  apply (case_tac "finite A")
  apply (induct set: finite)
  apply (auto simp add: gcd_mult_cancel_int)
done

lemma coprime_common_divisor_nat: "coprime (a::nat) b \<Longrightarrow> x dvd a \<Longrightarrow>
    x dvd b \<Longrightarrow> x = 1"
  apply (subgoal_tac "x dvd gcd a b")
  apply simp
  apply (erule (1) gcd_greatest)
done

lemma coprime_common_divisor_int: "coprime (a::int) b \<Longrightarrow> x dvd a \<Longrightarrow>
    x dvd b \<Longrightarrow> abs x = 1"
  apply (subgoal_tac "x dvd gcd a b")
  apply simp
  apply (erule (1) gcd_greatest)
done

lemma coprime_divisors_nat: "(d::int) dvd a \<Longrightarrow> e dvd b \<Longrightarrow> coprime a b \<Longrightarrow>
    coprime d e"
  apply (auto simp add: dvd_def)
  apply (frule coprime_lmult_int)
  apply (subst gcd_commute_int)
  apply (subst (asm) (2) gcd_commute_int)
  apply (erule coprime_lmult_int)
done

lemma invertible_coprime_nat: "(x::nat) * y mod m = 1 \<Longrightarrow> coprime x m"
apply (metis coprime_lmult_nat gcd_1_nat gcd_commute_nat gcd_red_nat)
done

lemma invertible_coprime_int: "(x::int) * y mod m = 1 \<Longrightarrow> coprime x m"
apply (metis coprime_lmult_int gcd_1_int gcd_commute_int gcd_red_int)
done

subsection {* Bezout's theorem *}

(* Function bezw returns a pair of witnesses to Bezout's theorem --
   see the theorems that follow the definition. *)
fun
  bezw  :: "nat \<Rightarrow> nat \<Rightarrow> int * int"
where
  "bezw x y =
  (if y = 0 then (1, 0) else
      (snd (bezw y (x mod y)),
       fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y)))"

lemma bezw_0 [simp]: "bezw x 0 = (1, 0)" by simp

lemma bezw_non_0: "y > 0 \<Longrightarrow> bezw x y = (snd (bezw y (x mod y)),
       fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y))"
  by simp

declare bezw.simps [simp del]

lemma bezw_aux [rule_format]:
    "fst (bezw x y) * int x + snd (bezw x y) * int y = int (gcd x y)"
proof (induct x y rule: gcd_nat_induct)
  fix m :: nat
  show "fst (bezw m 0) * int m + snd (bezw m 0) * int 0 = int (gcd m 0)"
    by auto
  next fix m :: nat and n
    assume ngt0: "n > 0" and
      ih: "fst (bezw n (m mod n)) * int n +
        snd (bezw n (m mod n)) * int (m mod n) =
        int (gcd n (m mod n))"
    thus "fst (bezw m n) * int m + snd (bezw m n) * int n = int (gcd m n)"
      apply (simp add: bezw_non_0 gcd_non_0_nat)
      apply (erule subst)
      apply (simp add: field_simps)
      apply (subst mod_div_equality [of m n, symmetric])
      (* applying simp here undoes the last substitution!
         what is procedure cancel_div_mod? *)
      apply (simp only: NO_MATCH_def field_simps of_nat_add of_nat_mult)
      done
qed

lemma bezout_int:
  fixes x y
  shows "EX u v. u * (x::int) + v * y = gcd x y"
proof -
  have bezout_aux: "!!x y. x \<ge> (0::int) \<Longrightarrow> y \<ge> 0 \<Longrightarrow>
      EX u v. u * x + v * y = gcd x y"
    apply (rule_tac x = "fst (bezw (nat x) (nat y))" in exI)
    apply (rule_tac x = "snd (bezw (nat x) (nat y))" in exI)
    apply (unfold gcd_int_def)
    apply simp
    apply (subst bezw_aux [symmetric])
    apply auto
    done
  have "(x \<ge> 0 \<and> y \<ge> 0) | (x \<ge> 0 \<and> y \<le> 0) | (x \<le> 0 \<and> y \<ge> 0) |
      (x \<le> 0 \<and> y \<le> 0)"
    by auto
  moreover have "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
    by (erule (1) bezout_aux)
  moreover have "x >= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> ?thesis"
    apply (insert bezout_aux [of x "-y"])
    apply auto
    apply (rule_tac x = u in exI)
    apply (rule_tac x = "-v" in exI)
    apply (subst gcd_neg2_int [symmetric])
    apply auto
    done
  moreover have "x <= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> ?thesis"
    apply (insert bezout_aux [of "-x" y])
    apply auto
    apply (rule_tac x = "-u" in exI)
    apply (rule_tac x = v in exI)
    apply (subst gcd_neg1_int [symmetric])
    apply auto
    done
  moreover have "x <= 0 \<Longrightarrow> y <= 0 \<Longrightarrow> ?thesis"
    apply (insert bezout_aux [of "-x" "-y"])
    apply auto
    apply (rule_tac x = "-u" in exI)
    apply (rule_tac x = "-v" in exI)
    apply (subst gcd_neg1_int [symmetric])
    apply (subst gcd_neg2_int [symmetric])
    apply auto
    done
  ultimately show ?thesis by blast
qed

text {* versions of Bezout for nat, by Amine Chaieb *}

lemma ind_euclid:
  assumes c: " \<forall>a b. P (a::nat) b \<longleftrightarrow> P b a" and z: "\<forall>a. P a 0"
  and add: "\<forall>a b. P a b \<longrightarrow> P a (a + b)"
  shows "P a b"
proof(induct "a + b" arbitrary: a b rule: less_induct)
  case less
  have "a = b \<or> a < b \<or> b < a" by arith
  moreover {assume eq: "a= b"
    from add[rule_format, OF z[rule_format, of a]] have "P a b" using eq
    by simp}
  moreover
  {assume lt: "a < b"
    hence "a + b - a < a + b \<or> a = 0" by arith
    moreover
    {assume "a =0" with z c have "P a b" by blast }
    moreover
    {assume "a + b - a < a + b"
      also have th0: "a + b - a = a + (b - a)" using lt by arith
      finally have "a + (b - a) < a + b" .
      then have "P a (a + (b - a))" by (rule add[rule_format, OF less])
      then have "P a b" by (simp add: th0[symmetric])}
    ultimately have "P a b" by blast}
  moreover
  {assume lt: "a > b"
    hence "b + a - b < a + b \<or> b = 0" by arith
    moreover
    {assume "b =0" with z c have "P a b" by blast }
    moreover
    {assume "b + a - b < a + b"
      also have th0: "b + a - b = b + (a - b)" using lt by arith
      finally have "b + (a - b) < a + b" .
      then have "P b (b + (a - b))" by (rule add[rule_format, OF less])
      then have "P b a" by (simp add: th0[symmetric])
      hence "P a b" using c by blast }
    ultimately have "P a b" by blast}
ultimately  show "P a b" by blast
qed

lemma bezout_lemma_nat:
  assumes ex: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
    (a * x = b * y + d \<or> b * x = a * y + d)"
  shows "\<exists>d x y. d dvd a \<and> d dvd a + b \<and>
    (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
  using ex
  apply clarsimp
  apply (rule_tac x="d" in exI, simp)
  apply (case_tac "a * x = b * y + d" , simp_all)
  apply (rule_tac x="x + y" in exI)
  apply (rule_tac x="y" in exI)
  apply algebra
  apply (rule_tac x="x" in exI)
  apply (rule_tac x="x + y" in exI)
  apply algebra
done

lemma bezout_add_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
    (a * x = b * y + d \<or> b * x = a * y + d)"
  apply(induct a b rule: ind_euclid)
  apply blast
  apply clarify
  apply (rule_tac x="a" in exI, simp)
  apply clarsimp
  apply (rule_tac x="d" in exI)
  apply (case_tac "a * x = b * y + d", simp_all)
  apply (rule_tac x="x+y" in exI)
  apply (rule_tac x="y" in exI)
  apply algebra
  apply (rule_tac x="x" in exI)
  apply (rule_tac x="x+y" in exI)
  apply algebra
done

lemma bezout1_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
    (a * x - b * y = d \<or> b * x - a * y = d)"
  using bezout_add_nat[of a b]
  apply clarsimp
  apply (rule_tac x="d" in exI, simp)
  apply (rule_tac x="x" in exI)
  apply (rule_tac x="y" in exI)
  apply auto
done

lemma bezout_add_strong_nat: assumes nz: "a \<noteq> (0::nat)"
  shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
proof-
 from nz have ap: "a > 0" by simp
 from bezout_add_nat[of a b]
 have "(\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d) \<or>
   (\<exists>d x y. d dvd a \<and> d dvd b \<and> b * x = a * y + d)" by blast
 moreover
    {fix d x y assume H: "d dvd a" "d dvd b" "a * x = b * y + d"
     from H have ?thesis by blast }
 moreover
 {fix d x y assume H: "d dvd a" "d dvd b" "b * x = a * y + d"
   {assume b0: "b = 0" with H  have ?thesis by simp}
   moreover
   {assume b: "b \<noteq> 0" hence bp: "b > 0" by simp
     from b dvd_imp_le [OF H(2)] have "d < b \<or> d = b"
       by auto
     moreover
     {assume db: "d=b"
       with nz H have ?thesis apply simp
         apply (rule exI[where x = b], simp)
         apply (rule exI[where x = b])
        by (rule exI[where x = "a - 1"], simp add: diff_mult_distrib2)}
    moreover
    {assume db: "d < b"
        {assume "x=0" hence ?thesis using nz H by simp }
        moreover
        {assume x0: "x \<noteq> 0" hence xp: "x > 0" by simp
          from db have "d \<le> b - 1" by simp
          hence "d*b \<le> b*(b - 1)" by simp
          with xp mult_mono[of "1" "x" "d*b" "b*(b - 1)"]
          have dble: "d*b \<le> x*b*(b - 1)" using bp by simp
          from H (3) have "d + (b - 1) * (b*x) = d + (b - 1) * (a*y + d)"
            by simp
          hence "d + (b - 1) * a * y + (b - 1) * d = d + (b - 1) * b * x"
            by (simp only: mult.assoc distrib_left)
          hence "a * ((b - 1) * y) + d * (b - 1 + 1) = d + x*b*(b - 1)"
            by algebra
          hence "a * ((b - 1) * y) = d + x*b*(b - 1) - d*b" using bp by simp
          hence "a * ((b - 1) * y) = d + (x*b*(b - 1) - d*b)"
            by (simp only: diff_add_assoc[OF dble, of d, symmetric])
          hence "a * ((b - 1) * y) = b*(x*(b - 1) - d) + d"
            by (simp only: diff_mult_distrib2 ac_simps)
          hence ?thesis using H(1,2)
            apply -
            apply (rule exI[where x=d], simp)
            apply (rule exI[where x="(b - 1) * y"])
            by (rule exI[where x="x*(b - 1) - d"], simp)}
        ultimately have ?thesis by blast}
    ultimately have ?thesis by blast}
  ultimately have ?thesis by blast}
 ultimately show ?thesis by blast
qed

lemma bezout_nat: assumes a: "(a::nat) \<noteq> 0"
  shows "\<exists>x y. a * x = b * y + gcd a b"
proof-
  let ?g = "gcd a b"
  from bezout_add_strong_nat[OF a, of b]
  obtain d x y where d: "d dvd a" "d dvd b" "a * x = b * y + d" by blast
  from d(1,2) have "d dvd ?g" by simp
  then obtain k where k: "?g = d*k" unfolding dvd_def by blast
  from d(3) have "a * x * k = (b * y + d) *k " by auto
  hence "a * (x * k) = b * (y*k) + ?g" by (algebra add: k)
  thus ?thesis by blast
qed

subsection {* LCM properties *}

lemma lcm_altdef_int [code]: "lcm (a::int) b = (abs a) * (abs b) div gcd a b"
  by (simp add: lcm_int_def lcm_nat_def zdiv_int
    of_nat_mult gcd_int_def)

lemma prod_gcd_lcm_nat: "(m::nat) * n = gcd m n * lcm m n"
  unfolding lcm_nat_def
  by (simp add: dvd_mult_div_cancel [OF gcd_dvd_prod_nat])

lemma prod_gcd_lcm_int: "abs(m::int) * abs n = gcd m n * lcm m n"
  unfolding lcm_int_def gcd_int_def
  apply (subst int_mult [symmetric])
  apply (subst prod_gcd_lcm_nat [symmetric])
  apply (subst nat_abs_mult_distrib [symmetric])
  apply (simp, simp add: abs_mult)
done

lemma lcm_0_nat [simp]: "lcm (m::nat) 0 = 0"
  unfolding lcm_nat_def by simp

lemma lcm_0_int [simp]: "lcm (m::int) 0 = 0"
  unfolding lcm_int_def by simp

lemma lcm_0_left_nat [simp]: "lcm (0::nat) n = 0"
  unfolding lcm_nat_def by simp

lemma lcm_0_left_int [simp]: "lcm (0::int) n = 0"
  unfolding lcm_int_def by simp

lemma lcm_pos_nat:
  "(m::nat) > 0 \<Longrightarrow> n>0 \<Longrightarrow> lcm m n > 0"
by (metis gr0I mult_is_0 prod_gcd_lcm_nat)

lemma lcm_pos_int:
  "(m::int) ~= 0 \<Longrightarrow> n ~= 0 \<Longrightarrow> lcm m n > 0"
  apply (subst lcm_abs_int)
  apply (rule lcm_pos_nat [transferred])
  apply auto
done

lemma dvd_pos_nat:
  fixes n m :: nat
  assumes "n > 0" and "m dvd n"
  shows "m > 0"
using assms by (cases m) auto

lemma lcm_least_nat:
  assumes "(m::nat) dvd k" and "n dvd k"
  shows "lcm m n dvd k"
proof (cases k)
  case 0 then show ?thesis by auto
next
  case (Suc _) then have pos_k: "k > 0" by auto
  from assms dvd_pos_nat [OF this] have pos_mn: "m > 0" "n > 0" by auto
  with gcd_zero_nat [of m n] have pos_gcd: "gcd m n > 0" by simp
  from assms obtain p where k_m: "k = m * p" using dvd_def by blast
  from assms obtain q where k_n: "k = n * q" using dvd_def by blast
  from pos_k k_m have pos_p: "p > 0" by auto
  from pos_k k_n have pos_q: "q > 0" by auto
  have "k * k * gcd q p = k * gcd (k * q) (k * p)"
    by (simp add: ac_simps gcd_mult_distrib_nat)
  also have "\<dots> = k * gcd (m * p * q) (n * q * p)"
    by (simp add: k_m [symmetric] k_n [symmetric])
  also have "\<dots> = k * p * q * gcd m n"
    by (simp add: ac_simps gcd_mult_distrib_nat)
  finally have "(m * p) * (n * q) * gcd q p = k * p * q * gcd m n"
    by (simp only: k_m [symmetric] k_n [symmetric])
  then have "p * q * m * n * gcd q p = p * q * k * gcd m n"
    by (simp add: ac_simps)
  with pos_p pos_q have "m * n * gcd q p = k * gcd m n"
    by simp
  with prod_gcd_lcm_nat [of m n]
  have "lcm m n * gcd q p * gcd m n = k * gcd m n"
    by (simp add: ac_simps)
  with pos_gcd have "lcm m n * gcd q p = k" by auto
  then show ?thesis using dvd_def by auto
qed

lemma lcm_least_int:
  "(m::int) dvd k \<Longrightarrow> n dvd k \<Longrightarrow> lcm m n dvd k"
apply (subst lcm_abs_int)
apply (rule dvd_trans)
apply (rule lcm_least_nat [transferred, of _ "abs k" _])
apply auto
done

lemma lcm_dvd1_nat: "(m::nat) dvd lcm m n"
proof (cases m)
  case 0 then show ?thesis by simp
next
  case (Suc _)
  then have mpos: "m > 0" by simp
  show ?thesis
  proof (cases n)
    case 0 then show ?thesis by simp
  next
    case (Suc _)
    then have npos: "n > 0" by simp
    have "gcd m n dvd n" by simp
    then obtain k where "n = gcd m n * k" using dvd_def by auto
    then have "m * n div gcd m n = m * (gcd m n * k) div gcd m n"
      by (simp add: ac_simps)
    also have "\<dots> = m * k" using mpos npos gcd_zero_nat by simp
    finally show ?thesis by (simp add: lcm_nat_def)
  qed
qed

lemma lcm_dvd1_int: "(m::int) dvd lcm m n"
  apply (subst lcm_abs_int)
  apply (rule dvd_trans)
  prefer 2
  apply (rule lcm_dvd1_nat [transferred])
  apply auto
done

lemma lcm_dvd2_nat: "(n::nat) dvd lcm m n"
  using lcm_dvd1_nat [of n m] by (simp only: lcm_nat_def mult.commute gcd_nat.commute)

lemma lcm_dvd2_int: "(n::int) dvd lcm m n"
  using lcm_dvd1_int [of n m] by (simp only: lcm_int_def lcm_nat_def mult.commute gcd_nat.commute)

lemma dvd_lcm_I1_nat[simp]: "(k::nat) dvd m \<Longrightarrow> k dvd lcm m n"
by(metis lcm_dvd1_nat dvd_trans)

lemma dvd_lcm_I2_nat[simp]: "(k::nat) dvd n \<Longrightarrow> k dvd lcm m n"
by(metis lcm_dvd2_nat dvd_trans)

lemma dvd_lcm_I1_int[simp]: "(i::int) dvd m \<Longrightarrow> i dvd lcm m n"
by(metis lcm_dvd1_int dvd_trans)

lemma dvd_lcm_I2_int[simp]: "(i::int) dvd n \<Longrightarrow> i dvd lcm m n"
by(metis lcm_dvd2_int dvd_trans)

lemma lcm_unique_nat: "(a::nat) dvd d \<and> b dvd d \<and>
    (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
  by (auto intro: dvd_antisym lcm_least_nat lcm_dvd1_nat lcm_dvd2_nat)

lemma lcm_unique_int: "d >= 0 \<and> (a::int) dvd d \<and> b dvd d \<and>
    (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
  by (auto intro: dvd_antisym [transferred] lcm_least_int)

interpretation lcm_nat: abel_semigroup "lcm :: nat \<Rightarrow> nat \<Rightarrow> nat"
  + lcm_nat: semilattice_neutr "lcm :: nat \<Rightarrow> nat \<Rightarrow> nat" 1
proof
  fix n m p :: nat
  show "lcm (lcm n m) p = lcm n (lcm m p)"
    by (rule lcm_unique_nat [THEN iffD1]) (metis dvd.order_trans lcm_unique_nat)
  show "lcm m n = lcm n m"
    by (simp add: lcm_nat_def gcd_commute_nat field_simps)
  show "lcm m m = m"
    by (metis dvd.order_refl lcm_unique_nat)
  show "lcm m 1 = m"
    by (metis dvd.dual_order.refl lcm_unique_nat one_dvd)
qed

interpretation lcm_int: abel_semigroup "lcm :: int \<Rightarrow> int \<Rightarrow> int"
proof
  fix n m p :: int
  show "lcm (lcm n m) p = lcm n (lcm m p)"
    by (rule lcm_unique_int [THEN iffD1]) (metis dvd_trans lcm_unique_int)
  show "lcm m n = lcm n m"
    by (simp add: lcm_int_def lcm_nat.commute)
qed

lemmas lcm_assoc_nat = lcm_nat.assoc
lemmas lcm_commute_nat = lcm_nat.commute
lemmas lcm_left_commute_nat = lcm_nat.left_commute
lemmas lcm_assoc_int = lcm_int.assoc
lemmas lcm_commute_int = lcm_int.commute
lemmas lcm_left_commute_int = lcm_int.left_commute

lemmas lcm_ac_nat = lcm_assoc_nat lcm_commute_nat lcm_left_commute_nat
lemmas lcm_ac_int = lcm_assoc_int lcm_commute_int lcm_left_commute_int

lemma lcm_proj2_if_dvd_nat [simp]: "(x::nat) dvd y \<Longrightarrow> lcm x y = y"
  apply (rule sym)
  apply (subst lcm_unique_nat [symmetric])
  apply auto
done

lemma lcm_proj2_if_dvd_int [simp]: "(x::int) dvd y \<Longrightarrow> lcm x y = abs y"
  apply (rule sym)
  apply (subst lcm_unique_int [symmetric])
  apply auto
done

lemma lcm_proj1_if_dvd_nat [simp]: "(x::nat) dvd y \<Longrightarrow> lcm y x = y"
by (subst lcm_commute_nat, erule lcm_proj2_if_dvd_nat)

lemma lcm_proj1_if_dvd_int [simp]: "(x::int) dvd y \<Longrightarrow> lcm y x = abs y"
by (subst lcm_commute_int, erule lcm_proj2_if_dvd_int)

lemma lcm_proj1_iff_nat[simp]: "lcm m n = (m::nat) \<longleftrightarrow> n dvd m"
by (metis lcm_proj1_if_dvd_nat lcm_unique_nat)

lemma lcm_proj2_iff_nat[simp]: "lcm m n = (n::nat) \<longleftrightarrow> m dvd n"
by (metis lcm_proj2_if_dvd_nat lcm_unique_nat)

lemma lcm_proj1_iff_int[simp]: "lcm m n = abs(m::int) \<longleftrightarrow> n dvd m"
by (metis dvd_abs_iff lcm_proj1_if_dvd_int lcm_unique_int)

lemma lcm_proj2_iff_int[simp]: "lcm m n = abs(n::int) \<longleftrightarrow> m dvd n"
by (metis dvd_abs_iff lcm_proj2_if_dvd_int lcm_unique_int)

lemma comp_fun_idem_gcd_nat: "comp_fun_idem (gcd :: nat\<Rightarrow>nat\<Rightarrow>nat)"
proof qed (auto simp add: gcd_ac_nat)

lemma comp_fun_idem_gcd_int: "comp_fun_idem (gcd :: int\<Rightarrow>int\<Rightarrow>int)"
proof qed (auto simp add: gcd_ac_int)

lemma comp_fun_idem_lcm_nat: "comp_fun_idem (lcm :: nat\<Rightarrow>nat\<Rightarrow>nat)"
proof qed (auto simp add: lcm_ac_nat)

lemma comp_fun_idem_lcm_int: "comp_fun_idem (lcm :: int\<Rightarrow>int\<Rightarrow>int)"
proof qed (auto simp add: lcm_ac_int)

(* FIXME introduce selimattice_bot/top and derive the following lemmas in there: *)

lemma lcm_0_iff_nat[simp]: "lcm (m::nat) n = 0 \<longleftrightarrow> m=0 \<or> n=0"
by (metis lcm_0_left_nat lcm_0_nat mult_is_0 prod_gcd_lcm_nat)

lemma lcm_0_iff_int[simp]: "lcm (m::int) n = 0 \<longleftrightarrow> m=0 \<or> n=0"
by (metis lcm_0_int lcm_0_left_int lcm_pos_int less_le)

lemma lcm_1_iff_nat[simp]: "lcm (m::nat) n = 1 \<longleftrightarrow> m=1 \<and> n=1"
by (metis gcd_1_nat lcm_unique_nat nat_mult_1 prod_gcd_lcm_nat)

lemma lcm_1_iff_int[simp]: "lcm (m::int) n = 1 \<longleftrightarrow> (m=1 \<or> m = -1) \<and> (n=1 \<or> n = -1)"
by (auto simp add: abs_mult_self trans [OF lcm_unique_int eq_commute, symmetric] zmult_eq_1_iff)

subsection {* The complete divisibility lattice *}

interpretation gcd_semilattice_nat: semilattice_inf gcd "op dvd" "(%m n::nat. m dvd n & ~ n dvd m)"
proof
  case goal3 thus ?case by(metis gcd_unique_nat)
qed auto

interpretation lcm_semilattice_nat: semilattice_sup lcm "op dvd" "(%m n::nat. m dvd n & ~ n dvd m)"
proof
  case goal3 thus ?case by(metis lcm_unique_nat)
qed auto

interpretation gcd_lcm_lattice_nat: lattice gcd "op dvd" "(%m n::nat. m dvd n & ~ n dvd m)" lcm ..

text{* Lifting gcd and lcm to sets (Gcd/Lcm).
Gcd is defined via Lcm to facilitate the proof that we have a complete lattice.
*}

class Gcd = gcd +
  fixes Gcd :: "'a set \<Rightarrow> 'a"
  fixes Lcm :: "'a set \<Rightarrow> 'a"

instantiation nat :: Gcd
begin

definition
  "Lcm (M::nat set) = (if finite M then semilattice_neutr_set.F lcm 1 M else 0)"

interpretation semilattice_neutr_set lcm "1::nat" ..

lemma Lcm_nat_infinite:
  "\<not> finite M \<Longrightarrow> Lcm M = (0::nat)"
  by (simp add: Lcm_nat_def)

lemma Lcm_nat_empty:
  "Lcm {} = (1::nat)"
  by (simp add: Lcm_nat_def)

lemma Lcm_nat_insert:
  "Lcm (insert n M) = lcm (n::nat) (Lcm M)"
  by (cases "finite M") (simp_all add: Lcm_nat_def Lcm_nat_infinite)

definition
  "Gcd (M::nat set) = Lcm {d. \<forall>m\<in>M. d dvd m}"

instance ..

end

lemma dvd_Lcm_nat [simp]:
  fixes M :: "nat set"
  assumes "m \<in> M"
  shows "m dvd Lcm M"
proof (cases "finite M")
  case False then show ?thesis by (simp add: Lcm_nat_infinite)
next
  case True then show ?thesis using assms by (induct M) (auto simp add: Lcm_nat_insert)
qed

lemma Lcm_dvd_nat [simp]:
  fixes M :: "nat set"
  assumes "\<forall>m\<in>M. m dvd n"
  shows "Lcm M dvd n"
proof (cases "n = 0")
  assume "n \<noteq> 0"
  hence "finite {d. d dvd n}" by (rule finite_divisors_nat)
  moreover have "M \<subseteq> {d. d dvd n}" using assms by fast
  ultimately have "finite M" by (rule rev_finite_subset)
  then show ?thesis using assms by (induct M) (simp_all add: Lcm_nat_empty Lcm_nat_insert)
qed simp

interpretation gcd_lcm_complete_lattice_nat:
  complete_lattice Gcd Lcm gcd Rings.dvd "\<lambda>m n. m dvd n \<and> \<not> n dvd m" lcm 1 "0::nat"
where
  "Inf.INFIMUM Gcd A f = Gcd (f ` A :: nat set)"
  and "Sup.SUPREMUM Lcm A f = Lcm (f ` A)"
proof -
  show "class.complete_lattice Gcd Lcm gcd Rings.dvd (\<lambda>m n. m dvd n \<and> \<not> n dvd m) lcm 1 (0::nat)"
  proof
    case goal1 thus ?case by (simp add: Gcd_nat_def)
  next
    case goal2 thus ?case by (simp add: Gcd_nat_def)
  next
    case goal5 show ?case by (simp add: Gcd_nat_def Lcm_nat_infinite)
  next
    case goal6 show ?case by (simp add: Lcm_nat_empty)
  next
    case goal3 thus ?case by simp
  next
    case goal4 thus ?case by simp
  qed
  then interpret gcd_lcm_complete_lattice_nat:
    complete_lattice Gcd Lcm gcd Rings.dvd "\<lambda>m n. m dvd n \<and> \<not> n dvd m" lcm 1 "0::nat" .
  from gcd_lcm_complete_lattice_nat.INF_def show "Inf.INFIMUM Gcd A f = Gcd (f ` A)" .
  from gcd_lcm_complete_lattice_nat.SUP_def show "Sup.SUPREMUM Lcm A f = Lcm (f ` A)" .
qed

declare gcd_lcm_complete_lattice_nat.Inf_image_eq [simp del]
declare gcd_lcm_complete_lattice_nat.Sup_image_eq [simp del]

lemma Lcm_empty_nat: "Lcm {} = (1::nat)"
  by (fact Lcm_nat_empty)

lemma Gcd_empty_nat: "Gcd {} = (0::nat)"
  by (fact gcd_lcm_complete_lattice_nat.Inf_empty) (* already simp *)

lemma Lcm_insert_nat [simp]:
  shows "Lcm (insert (n::nat) N) = lcm n (Lcm N)"
  by (fact gcd_lcm_complete_lattice_nat.Sup_insert)

lemma Gcd_insert_nat [simp]:
  shows "Gcd (insert (n::nat) N) = gcd n (Gcd N)"
  by (fact gcd_lcm_complete_lattice_nat.Inf_insert)

lemma Lcm0_iff[simp]: "finite (M::nat set) \<Longrightarrow> M \<noteq> {} \<Longrightarrow> Lcm M = 0 \<longleftrightarrow> 0 : M"
by(induct rule:finite_ne_induct) auto

lemma Lcm_eq_0[simp]: "finite (M::nat set) \<Longrightarrow> 0 : M \<Longrightarrow> Lcm M = 0"
by (metis Lcm0_iff empty_iff)

lemma Gcd_dvd_nat [simp]:
  fixes M :: "nat set"
  assumes "m \<in> M" shows "Gcd M dvd m"
  using assms by (fact gcd_lcm_complete_lattice_nat.Inf_lower)

lemma dvd_Gcd_nat[simp]:
  fixes M :: "nat set"
  assumes "\<forall>m\<in>M. n dvd m" shows "n dvd Gcd M"
  using assms by (simp only: gcd_lcm_complete_lattice_nat.Inf_greatest)

text{* Alternative characterizations of Gcd: *}

lemma Gcd_eq_Max: "finite(M::nat set) \<Longrightarrow> M \<noteq> {} \<Longrightarrow> 0 \<notin> M \<Longrightarrow> Gcd M = Max(\<Inter>m\<in>M. {d. d dvd m})"
apply(rule antisym)
 apply(rule Max_ge)
  apply (metis all_not_in_conv finite_divisors_nat finite_INT)
 apply simp
apply (rule Max_le_iff[THEN iffD2])
  apply (metis all_not_in_conv finite_divisors_nat finite_INT)
 apply fastforce
apply clarsimp
apply (metis Gcd_dvd_nat Max_in dvd_0_left dvd_Gcd_nat dvd_imp_le linorder_antisym_conv3 not_less0)
done

lemma Gcd_remove0_nat: "finite M \<Longrightarrow> Gcd M = Gcd (M - {0::nat})"
apply(induct pred:finite)
 apply simp
apply(case_tac "x=0")
 apply simp
apply(subgoal_tac "insert x F - {0} = insert x (F - {0})")
 apply simp
apply blast
done

lemma Lcm_in_lcm_closed_set_nat:
  "finite M \<Longrightarrow> M \<noteq> {} \<Longrightarrow> ALL m n :: nat. m:M \<longrightarrow> n:M \<longrightarrow> lcm m n : M \<Longrightarrow> Lcm M : M"
apply(induct rule:finite_linorder_min_induct)
 apply simp
apply simp
apply(subgoal_tac "ALL m n :: nat. m:A \<longrightarrow> n:A \<longrightarrow> lcm m n : A")
 apply simp
 apply(case_tac "A={}")
  apply simp
 apply simp
apply (metis lcm_pos_nat lcm_unique_nat linorder_neq_iff nat_dvd_not_less not_less0)
done

lemma Lcm_eq_Max_nat:
  "finite M \<Longrightarrow> M \<noteq> {} \<Longrightarrow> 0 \<notin> M \<Longrightarrow> ALL m n :: nat. m:M \<longrightarrow> n:M \<longrightarrow> lcm m n : M \<Longrightarrow> Lcm M = Max M"
apply(rule antisym)
 apply(rule Max_ge, assumption)
 apply(erule (2) Lcm_in_lcm_closed_set_nat)
apply clarsimp
apply (metis Lcm0_iff dvd_Lcm_nat dvd_imp_le neq0_conv)
done

lemma Lcm_set_nat [code, code_unfold]:
  "Lcm (set ns) = fold lcm ns (1::nat)"
  by (fact gcd_lcm_complete_lattice_nat.Sup_set_fold)

lemma Gcd_set_nat [code, code_unfold]:
  "Gcd (set ns) = fold gcd ns (0::nat)"
  by (fact gcd_lcm_complete_lattice_nat.Inf_set_fold)

lemma mult_inj_if_coprime_nat:
  "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> ALL a:A. ALL b:B. coprime (f a) (g b)
   \<Longrightarrow> inj_on (%(a,b). f a * g b::nat) (A \<times> B)"
apply(auto simp add:inj_on_def)
apply (metis coprime_dvd_mult_iff_nat dvd.neq_le_trans dvd_triv_left)
apply (metis gcd_semilattice_nat.inf_commute coprime_dvd_mult_iff_nat
             dvd.neq_le_trans dvd_triv_right mult.commute)
done

text{* Nitpick: *}

lemma gcd_eq_nitpick_gcd [nitpick_unfold]: "gcd x y = Nitpick.nat_gcd x y"
by (induct x y rule: nat_gcd.induct)
   (simp add: gcd_nat.simps Nitpick.nat_gcd.simps)

lemma lcm_eq_nitpick_lcm [nitpick_unfold]: "lcm x y = Nitpick.nat_lcm x y"
by (simp only: lcm_nat_def Nitpick.nat_lcm_def gcd_eq_nitpick_gcd)

subsubsection {* Setwise gcd and lcm for integers *}

instantiation int :: Gcd
begin

definition
  "Lcm M = int (Lcm (nat ` abs ` M))"

definition
  "Gcd M = int (Gcd (nat ` abs ` M))"

instance ..
end

lemma Lcm_empty_int [simp]: "Lcm {} = (1::int)"
  by (simp add: Lcm_int_def)

lemma Gcd_empty_int [simp]: "Gcd {} = (0::int)"
  by (simp add: Gcd_int_def)

lemma Lcm_insert_int [simp]:
  shows "Lcm (insert (n::int) N) = lcm n (Lcm N)"
  by (simp add: Lcm_int_def lcm_int_def)

lemma Gcd_insert_int [simp]:
  shows "Gcd (insert (n::int) N) = gcd n (Gcd N)"
  by (simp add: Gcd_int_def gcd_int_def)

lemma dvd_int_iff: "x dvd y \<longleftrightarrow> nat (abs x) dvd nat (abs y)"
  by (simp add: zdvd_int)

lemma dvd_Lcm_int [simp]:
  fixes M :: "int set" assumes "m \<in> M" shows "m dvd Lcm M"
  using assms by (simp add: Lcm_int_def dvd_int_iff)

lemma Lcm_dvd_int [simp]:
  fixes M :: "int set"
  assumes "\<forall>m\<in>M. m dvd n" shows "Lcm M dvd n"
  using assms by (simp add: Lcm_int_def dvd_int_iff)

lemma Gcd_dvd_int [simp]:
  fixes M :: "int set"
  assumes "m \<in> M" shows "Gcd M dvd m"
  using assms by (simp add: Gcd_int_def dvd_int_iff)

lemma dvd_Gcd_int[simp]:
  fixes M :: "int set"
  assumes "\<forall>m\<in>M. n dvd m" shows "n dvd Gcd M"
  using assms by (simp add: Gcd_int_def dvd_int_iff)

lemma Lcm_set_int [code, code_unfold]:
  "Lcm (set xs) = fold lcm xs (1::int)"
  by (induct xs rule: rev_induct) (simp_all add: lcm_commute_int)

lemma Gcd_set_int [code, code_unfold]:
  "Gcd (set xs) = fold gcd xs (0::int)"
  by (induct xs rule: rev_induct) (simp_all add: gcd_commute_int)

text \<open>Fact aliasses\<close>

lemmas gcd_dvd1_nat = gcd_dvd1 [where ?'a = nat]
  and gcd_dvd2_nat = gcd_dvd2 [where ?'a = nat]
  and gcd_greatest_nat = gcd_greatest [where ?'a = nat]

lemmas gcd_dvd1_int = gcd_dvd1 [where ?'a = int]
  and gcd_dvd2_int = gcd_dvd2 [where ?'a = int]
  and gcd_greatest_int = gcd_greatest [where ?'a = int]

end


(*
    $Id: sol.thy,v 1.3 2011/06/28 18:11:38 webertj Exp $
    Author: Martin Strecker
*)

header {* Summation, Flattening *}

(*<*) theory sol imports Main begin (*>*)

text{* Define a function @{text sum}, which computes the sum of
elements of a list of natural numbers. *}

primrec sum :: "nat list \<Rightarrow> nat" where
  "sum []     = 0"
| "sum (x#xs) = x + sum xs"

text{* Then, define a function @{text flatten} which flattens a list
of lists by appending the member lists. *}

primrec flatten :: "'a list list \<Rightarrow> 'a list" where
  "flatten []       = []"
| "flatten (xs#xss) = xs @ flatten xss"

text{* Test your functions by applying them to the following example lists: *}

lemma "sum [2::nat, 4, 8] = x"
  apply simp  -- {* x = 14 *}
oops

lemma "flatten [[2::nat, 3], [4, 5], [7, 9]] = x"
  apply simp  -- {* x = [2, 3, 4, 5, 7, 9] *}
oops

text{* Prove the following statements, or give a counterexample: *}

lemma "length (flatten xs) = sum (map length xs)"
  apply (induct "xs")
  apply auto
done

lemma sum_append: "sum (xs @ ys) = sum xs + sum ys"
  apply (induct "ys")
    apply simp
  apply (induct "xs")
  apply auto
done

lemma flatten_append: "flatten (xs @ ys) = flatten xs @ flatten ys"
  apply (induct "ys")
    apply simp
  apply (induct "xs")
  apply auto
done

lemma "flatten (map rev (rev xs)) = rev (flatten xs)"
  apply (induct "xs")
  apply (auto simp add: flatten_append)
done

lemma "flatten (rev (map rev xs)) = rev (flatten xs)"
  apply (induct "xs")
  apply (auto simp add: flatten_append)
done

lemma "list_all (list_all P) xs = list_all P (flatten xs)"
  apply (induct "xs")
  apply auto
done

lemma "flatten (rev xs) = flatten xs"
  quickcheck
oops

text{*
  A possible counterexample is:
  xs = [[0], [1]]
*}

lemma "sum (rev xs) = sum xs"
  apply (induct "xs")
  apply (auto simp add: sum_append)
done

text{* Find a (non-trivial) predicate @{text P} which satisfies *}

lemma "list_all P xs \<longrightarrow> length xs \<le> sum xs"
(*<*) oops (*>*)

lemma "list_all (\<lambda>x. 1 \<le> x) xs \<longrightarrow> length xs \<le> sum xs"
  apply (induct "xs")
  apply auto
done

text{* Define, by means of primitive recursion, a function @{text
list_exists} which checks whether an element satisfying a given property
is contained in the list: *}

primrec list_exists :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)" where
  "list_exists P []     = False"
| "list_exists P (x#xs) = (P x \<or> list_exists P xs)"

text{* Test your function on the following examples: *}

lemma "list_exists (\<lambda> n. n < 3) [4::nat, 3, 7] = b"
  apply simp  -- {* b is false *}
oops

lemma "list_exists (\<lambda> n. n < 4) [4::nat, 3, 7] = b"
  apply simp  -- {* b is true *}
oops

text{* Prove the following statements: *}

lemma list_exists_append:
  "list_exists P (xs @ ys) = (list_exists P xs \<or> list_exists P ys)"
  apply (induct "ys")
    apply simp
  apply (induct "xs")
  apply auto
done

lemma "list_exists (list_exists P) xs = list_exists P (flatten xs)"
  apply (induct "xs")
  apply (auto simp add: list_exists_append)
done

text{* You could have defined @{text list_exists} only with the aid of
@{text list_all}.  Do this now, i.e. define a function @{text
list_exists2} and show that it is equivalent to @{text list_exists}. *}

definition list_exists2 :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)" where
  "list_exists2 P xs == \<not> list_all (\<lambda>x. \<not> P x) xs"

lemma "list_exists2 P xs = list_exists P xs"
  apply (induct "xs")
  apply (auto simp add: list_exists2_def)
done

(*<*) end (*>*)


section\<open>Lemmas about undirected graphs\<close>

theory Ugraph_Lemmas
imports
  Prob_Lemmas
  Girth_Chromatic.Girth_Chromatic
begin

text\<open>The complete graph is a graph where all possible edges are present. It is wellformed by
definition.\<close>

definition complete :: "nat set \<Rightarrow> ugraph" where
"complete V = (V, all_edges V)"

lemma complete_wellformed: "uwellformed (complete V)"
unfolding complete_def uwellformed_def all_edges_def
by simp

text\<open>If the set of vertices is finite, the set of edges in the complete graph is finite.\<close>

lemma all_edges_finite: "finite V \<Longrightarrow> finite (all_edges V)"
unfolding all_edges_def
by simp

corollary complete_finite_edges: "finite V \<Longrightarrow> finite (uedges (complete V))"
unfolding complete_def using all_edges_finite
by simp

text\<open>The sets of possible edges of disjoint sets of vertices are disjoint.\<close>

lemma all_edges_disjoint: "S \<inter> T = {} \<Longrightarrow> all_edges S \<inter> all_edges T = {}"
unfolding all_edges_def
by force

text\<open>A graph is called `finite' if its set of edges and its set of vertices are finite.\<close>

definition "finite_graph G \<equiv> finite (uverts G) \<and> finite (uedges G)"

text\<open>The complete graph is finite.\<close>

corollary complete_finite: "finite V \<Longrightarrow> finite_graph (complete V)"
using complete_finite_edges unfolding finite_graph_def complete_def
by simp

text\<open>A graph is called `nonempty' if it contains at least one vertex and at least one edge.\<close>

definition "nonempty_graph G \<equiv> uverts G \<noteq> {} \<and> uedges G \<noteq> {}"

text\<open>A random graph is both wellformed and finite.\<close>

lemma (in edge_space) wellformed_and_finite:
  assumes "E \<in> Pow S_edges"
  shows "finite_graph (edge_ugraph E)" "uwellformed (edge_ugraph E)"
unfolding finite_graph_def
proof
  show "finite (uverts (edge_ugraph E))"
    unfolding edge_ugraph_def S_verts_def by simp
next
  show "finite (uedges (edge_ugraph E))"
    using assms unfolding edge_ugraph_def S_edges_def by (auto intro: all_edges_finite)
next
  show "uwellformed (edge_ugraph E)"
    using complete_wellformed unfolding edge_ugraph_def S_edges_def complete_def uwellformed_def by force
qed

text\<open>The probability for a random graph to have $e$ edges is $p ^ e$.\<close>

lemma (in edge_space) cylinder_empty_prob:
  "A \<subseteq> S_edges \<Longrightarrow> prob (cylinder S_edges A {}) = p ^ (card A)"
using cylinder_prob by auto

subsection\<open>Subgraphs\<close>

definition subgraph :: "ugraph \<Rightarrow> ugraph \<Rightarrow> bool" where
"subgraph G' G \<equiv> uverts G' \<subseteq> uverts G \<and> uedges G' \<subseteq> uedges G"

lemma subgraph_refl: "subgraph G G"
unfolding subgraph_def
by simp

lemma subgraph_trans: "subgraph G'' G' \<Longrightarrow> subgraph G' G \<Longrightarrow> subgraph G'' G"
unfolding subgraph_def
by auto

lemma subgraph_antisym: "subgraph G G' \<Longrightarrow> subgraph G' G \<Longrightarrow> G = G'"
unfolding subgraph_def
by (auto simp add: Product_Type.prod_eqI)

lemma subgraph_complete:
  assumes "uwellformed G"
  shows "subgraph G (complete (uverts G))"
proof -
  {
    fix e
    assume "e \<in> uedges G"
    with assms have "card e = 2" and u: "\<And>u. u \<in> e \<Longrightarrow> u \<in> uverts G"
      unfolding uwellformed_def by auto
    moreover then obtain u v where "e = {u, v}" "u \<noteq> v"
      by (metis card_2_elements)
    ultimately have "e = mk_uedge (u, v)" "u \<in> uverts G" "v \<in> uverts G"
      by auto
    hence "e \<in> all_edges (uverts G)"
      unfolding all_edges_def using \<open>u \<noteq> v\<close> by fastforce
  }
  thus ?thesis
    unfolding complete_def subgraph_def by auto
qed

corollary wellformed_all_edges: "uwellformed G \<Longrightarrow> uedges G \<subseteq> all_edges (uverts G)"
using subgraph_complete subgraph_def complete_def by simp

lemma subgraph_finite: "\<lbrakk> finite_graph G; subgraph G' G \<rbrakk> \<Longrightarrow> finite_graph G'"
unfolding finite_graph_def subgraph_def
by (metis rev_finite_subset)

corollary wellformed_finite:
  assumes "finite (uverts G)" and "uwellformed G"
  shows "finite_graph G"
proof (rule subgraph_finite[where G = "complete (uverts G)"])
  show "subgraph G (complete (uverts G))"
    using assms by (simp add: subgraph_complete)
next
  have "finite (uedges (complete (uverts G)))"
    using complete_finite_edges[OF assms(1)] .
  thus "finite_graph (complete (uverts G))"
    unfolding finite_graph_def complete_def using assms(1) by auto
qed

definition subgraphs :: "ugraph \<Rightarrow> ugraph set" where
"subgraphs G = {G'. subgraph G' G}"

definition nonempty_subgraphs :: "ugraph \<Rightarrow> ugraph set" where
"nonempty_subgraphs G = {G'. uwellformed G' \<and> subgraph G' G \<and> nonempty_graph G'}"

lemma subgraphs_finite:
  assumes "finite_graph G"
  shows "finite (subgraphs G)"
proof -
  have "subgraphs G = {(V', E'). V' \<subseteq> uverts G \<and> E' \<subseteq> uedges G}"
    unfolding subgraphs_def subgraph_def by force
  moreover have "finite (uverts G)" "finite (uedges G)"
    using assms unfolding finite_graph_def by auto
  ultimately show ?thesis
    by simp
qed

corollary nonempty_subgraphs_finite: "finite_graph G \<Longrightarrow> finite (nonempty_subgraphs G)"
using subgraphs_finite
unfolding nonempty_subgraphs_def subgraphs_def
by auto

subsection\<open>Induced subgraphs\<close>

definition induced_subgraph :: "uvert set \<Rightarrow> ugraph \<Rightarrow> ugraph" where
"induced_subgraph V G = (V, uedges G \<inter> all_edges V)"

lemma induced_is_subgraph:
  "V \<subseteq> uverts G \<Longrightarrow> subgraph (induced_subgraph V G) G"
  "V \<subseteq> uverts G \<Longrightarrow> subgraph (induced_subgraph V G) (complete V)"
unfolding subgraph_def induced_subgraph_def complete_def
by simp+

lemma induced_wellformed: "uwellformed G \<Longrightarrow> V \<subseteq> uverts G \<Longrightarrow> uwellformed (induced_subgraph V G)"
unfolding uwellformed_def induced_subgraph_def all_edges_def
by force

lemma subgraph_union_induced:
  assumes "uverts H\<^sub>1 \<subseteq> S" and "uverts H\<^sub>2 \<subseteq> T"
  assumes "uwellformed H\<^sub>1" and "uwellformed H\<^sub>2"
  shows "subgraph H\<^sub>1 (induced_subgraph S G) \<and> subgraph H\<^sub>2 (induced_subgraph T G) \<longleftrightarrow>
         subgraph (uverts H\<^sub>1 \<union> uverts H\<^sub>2, uedges H\<^sub>1 \<union> uedges H\<^sub>2) (induced_subgraph (S \<union> T) G)"
unfolding induced_subgraph_def subgraph_def
apply auto
using all_edges_mono apply blast
using all_edges_mono apply blast
using assms(1,2) wellformed_all_edges[OF assms(3)] wellformed_all_edges[OF assms(4)] all_edges_mono[OF assms(1)] all_edges_mono[OF assms(2)]
apply auto
done

lemma (in edge_space) induced_subgraph_prob:
  assumes "uverts H \<subseteq> V" and "uwellformed H" and "V \<subseteq> S_verts"
  shows "prob {es \<in> space P. subgraph H (induced_subgraph V (edge_ugraph es))} = p ^ card (uedges H)" (is "prob ?A = _")
proof -
  have "prob ?A = prob (cylinder S_edges (uedges H) {})"
    unfolding cylinder_def space_eq subgraph_def induced_subgraph_def edge_ugraph_def S_edges_def
    by (rule arg_cong[OF Collect_cong]) (metis (no_types) assms(1,2) Pow_iff all_edges_mono fst_conv inf_absorb1 inf_bot_left le_inf_iff snd_conv wellformed_all_edges)
  also have "\<dots> = p ^ card (uedges H)"
    proof (rule cylinder_empty_prob)
      have "uedges H \<subseteq> all_edges (uverts H)"
        by (rule wellformed_all_edges[OF assms(2)])
      also have "all_edges (uverts H) \<subseteq> all_edges S_verts"
        using assms by (auto simp: all_edges_mono[OF subset_trans])
      finally show "uedges H \<subseteq> S_edges"
        unfolding S_edges_def .
    qed
  finally show ?thesis
    .
qed

subsection\<open>Graph isomorphism\<close>

text\<open>We define graph isomorphism slightly different than in the literature. The usual definition
is that two graphs are isomorphic iff there exists a bijection between the vertex sets which
preserves the adjacency. However, this complicates many proofs.

Instead, we define the intuitive mapping operation on graphs. An isomorphism between two graphs
arises if there is a suitable mapping function from the first to the second graph. Later, we show
that this operation can be inverted.\<close>

fun map_ugraph :: "(nat \<Rightarrow> nat) \<Rightarrow> ugraph \<Rightarrow> ugraph" where
"map_ugraph f (V, E) = (f ` V, (\<lambda>e. f ` e) ` E)"

definition isomorphism :: "ugraph \<Rightarrow> ugraph \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> bool" where
"isomorphism G\<^sub>1 G\<^sub>2 f \<equiv> bij_betw f (uverts G\<^sub>1) (uverts G\<^sub>2) \<and> G\<^sub>2 = map_ugraph f G\<^sub>1"

abbreviation isomorphic :: "ugraph \<Rightarrow> ugraph \<Rightarrow> bool" ("_ \<simeq> _") where
"G\<^sub>1 \<simeq> G\<^sub>2 \<equiv> uwellformed G\<^sub>1 \<and> uwellformed G\<^sub>2 \<and> (\<exists>f. isomorphism G\<^sub>1 G\<^sub>2 f)"

lemma map_ugraph_id: "map_ugraph id = id"
unfolding fun_eq_iff
by simp

lemma map_ugraph_trans: "map_ugraph (g \<circ> f) = (map_ugraph g) \<circ> (map_ugraph f)"
  by (simp add: fun_eq_iff image_image)

lemma map_ugraph_wellformed:
  assumes "uwellformed G" and "inj_on f (uverts G)"
  shows "uwellformed (map_ugraph f G)"
unfolding uwellformed_def
proof safe
  fix e'
  assume "e' \<in> uedges (map_ugraph f G)"
  hence "e' \<in> (\<lambda>e. f ` e) ` (uedges G)"
    by (metis map_ugraph.simps snd_conv surjective_pairing)
  then obtain e where e: "e' = f ` e" "e \<in> uedges G"
    by blast
  hence "card e = 2" "e \<subseteq> uverts G"
    using assms(1) unfolding uwellformed_def by blast+
  thus "card e' = 2"
    using e(1) by (simp add: card_inj_subs[OF assms(2)])

  fix u'
  assume "u' \<in> e'"
  hence "u' \<in> f ` e"
    using e by force
  then obtain u where u: "u' = f u" "u \<in> e"
    by blast
  hence "u \<in> uverts G"
    using assms(1) e(2) unfolding uwellformed_def by blast
  hence "u' \<in> f ` uverts G"
    using u(1) by simp
  thus "u' \<in> uverts (map_ugraph f G)"
    by (metis map_ugraph.simps fst_conv surjective_pairing)
qed

lemma map_ugraph_finite: "finite_graph G \<Longrightarrow> finite_graph (map_ugraph f G)"
unfolding finite_graph_def
by (metis finite_imageI fst_conv map_ugraph.simps snd_conv surjective_pairing)

lemma map_ugraph_preserves_sub:
  assumes "subgraph G\<^sub>1 G\<^sub>2"
  shows "subgraph (map_ugraph f G\<^sub>1) (map_ugraph f G\<^sub>2)"
proof -
  have "f ` uverts G\<^sub>1 \<subseteq> f ` uverts G\<^sub>2" "(\<lambda>e. f ` e) ` uedges G\<^sub>1 \<subseteq> (\<lambda>e. f ` e) ` uedges G\<^sub>2"
    using assms(1) unfolding subgraph_def by auto
  thus ?thesis
    unfolding subgraph_def by (metis map_ugraph.simps fst_conv snd_conv surjective_pairing)
qed

lemma isomorphic_refl: "uwellformed G \<Longrightarrow> G \<simeq> G"
unfolding isomorphism_def
by (metis bij_betw_id id_def map_ugraph_id)

lemma isomorphic_trans:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2" and "G\<^sub>2 \<simeq> G\<^sub>3"
  shows "G\<^sub>1 \<simeq> G\<^sub>3"
proof -
  from assms obtain f\<^sub>1 f\<^sub>2 where
    bij: "bij_betw f\<^sub>1 (uverts G\<^sub>1) (uverts G\<^sub>2)" "bij_betw f\<^sub>2 (uverts G\<^sub>2) (uverts G\<^sub>3)" and
    map: "G\<^sub>2 = map_ugraph f\<^sub>1 G\<^sub>1" "G\<^sub>3 = map_ugraph f\<^sub>2 G\<^sub>2"
    unfolding isomorphism_def by blast

  let ?f = "f\<^sub>2 \<circ> f\<^sub>1"
  have "bij_betw ?f (uverts G\<^sub>1) (uverts G\<^sub>3)"
    using bij by (simp add: bij_betw_comp_iff)
  moreover have "G\<^sub>3 = map_ugraph ?f G\<^sub>1"
    using map by (simp add: map_ugraph_trans)
  moreover have "uwellformed G\<^sub>1" "uwellformed G\<^sub>3"
    using assms unfolding isomorphism_def by simp+
  ultimately show "G\<^sub>1 \<simeq> G\<^sub>3"
    unfolding isomorphism_def by blast
qed

lemma isomorphic_sym:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2"
  shows "G\<^sub>2 \<simeq> G\<^sub>1"
proof safe
  from assms obtain f where "isomorphism G\<^sub>1 G\<^sub>2 f"
    by blast
  hence bij: "bij_betw f (uverts G\<^sub>1) (uverts G\<^sub>2)" and map: "G\<^sub>2 = map_ugraph f G\<^sub>1"
    unfolding isomorphism_def by auto

  let ?f' = "inv_into (uverts G\<^sub>1) f"
  have bij': "bij_betw ?f' (uverts G\<^sub>2) (uverts G\<^sub>1)"
    by (rule bij_betw_inv_into) fact
  moreover have "uverts G\<^sub>1 = ?f' ` uverts G\<^sub>2"
    using bij' unfolding bij_betw_def by force
  moreover have "uedges G\<^sub>1 = (\<lambda>e. ?f' ` e) ` uedges G\<^sub>2"
    proof -
      have "uedges G\<^sub>1 = id ` uedges G\<^sub>1"
        by simp
      also have "\<dots> = (\<lambda>e. ?f' ` (f ` e)) ` uedges G\<^sub>1"
        proof (rule image_cong)
          fix a
          assume "a \<in> uedges G\<^sub>1"
          hence "a \<subseteq> uverts G\<^sub>1"
            using assms unfolding isomorphism_def uwellformed_def by blast
          thus "id a = inv_into (uverts G\<^sub>1) f ` f ` a"
            by (metis (full_types) id_def bij bij_betw_imp_inj_on inv_into_image_cancel)
        qed simp
      also have "\<dots> = (\<lambda>e. ?f' ` e) ` ((\<lambda>e. f ` e) ` uedges G\<^sub>1)"
        by (rule image_image[symmetric])
      also have "\<dots> = (\<lambda>e. ?f' ` e) ` uedges G\<^sub>2"
        using bij map by (metis map_ugraph.simps prod.collapse snd_eqD)
      finally show ?thesis
        .
    qed
  ultimately have "isomorphism G\<^sub>2 G\<^sub>1 ?f'"
    unfolding isomorphism_def by (metis map_ugraph.simps split_pairs)
  thus "\<exists>f. isomorphism G\<^sub>2 G\<^sub>1 f"
    by blast
qed (auto simp: assms)

lemma isomorphic_cards:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2"
  shows
    "card (uverts G\<^sub>1) = card (uverts G\<^sub>2)" (is "?V")
    "card (uedges G\<^sub>1) = card (uedges G\<^sub>2)" (is "?E")
proof -
  from assms obtain f where
    bij: "bij_betw f (uverts G\<^sub>1) (uverts G\<^sub>2)" and
    map: "G\<^sub>2 = map_ugraph f G\<^sub>1"
    unfolding isomorphism_def by blast
  from assms have wellformed: "uwellformed G\<^sub>1" "uwellformed G\<^sub>2"
    by simp+

  show ?V
    by (rule bij_betw_same_card[OF bij])

  let ?g = "\<lambda>e. f ` e"
  have "bij_betw ?g (Pow (uverts G\<^sub>1)) (Pow (uverts G\<^sub>2))"
    by (rule bij_lift[OF bij])
  moreover have "uedges G\<^sub>1 \<subseteq> Pow (uverts G\<^sub>1)"
    using wellformed(1) unfolding uwellformed_def by blast
  ultimately have "card (?g ` uedges G\<^sub>1) = card (uedges G\<^sub>1)"
    unfolding bij_betw_def by (metis card_inj_subs)
  thus ?E
    by (metis map map_ugraph.simps snd_conv surjective_pairing)
qed

subsection\<open>Isomorphic subgraphs\<close>

text\<open>The somewhat sloppy term `isomorphic subgraph' denotes a subgraph which is isomorphic to a
fixed other graph. For example, saying that a graph contains a triangle usually means that it
contains \emph{any} triangle, not the specific triangle with the nodes $1$, $2$ and $3$. Hence, such
a graph would have a triangle as an isomorphic subgraph.\<close>

definition subgraph_isomorphic :: "ugraph \<Rightarrow> ugraph \<Rightarrow> bool" ("_ \<sqsubseteq> _") where
"G' \<sqsubseteq> G \<equiv> uwellformed G \<and> (\<exists>G''. G' \<simeq> G'' \<and> subgraph G'' G)"

lemma subgraph_is_subgraph_isomorphic: "\<lbrakk> uwellformed G'; uwellformed G; subgraph G' G \<rbrakk> \<Longrightarrow> G' \<sqsubseteq> G"
unfolding subgraph_isomorphic_def
by (metis isomorphic_refl)

lemma isomorphic_is_subgraph_isomorphic: "G\<^sub>1 \<simeq> G\<^sub>2 \<Longrightarrow> G\<^sub>1 \<sqsubseteq> G\<^sub>2"
unfolding subgraph_isomorphic_def
by (metis subgraph_refl)

lemma subgraph_isomorphic_refl: "uwellformed G \<Longrightarrow> G \<sqsubseteq> G"
unfolding subgraph_isomorphic_def
by (metis isomorphic_refl subgraph_refl)

lemma subgraph_isomorphic_pre_iso_closed:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2" and "G\<^sub>2 \<sqsubseteq> G\<^sub>3"
  shows "G\<^sub>1 \<sqsubseteq> G\<^sub>3"
unfolding subgraph_isomorphic_def
proof
  show "uwellformed G\<^sub>3"
    using assms unfolding subgraph_isomorphic_def by blast
next
  from assms(2) obtain G\<^sub>2' where "G\<^sub>2 \<simeq> G\<^sub>2'" "subgraph G\<^sub>2' G\<^sub>3"
    unfolding subgraph_isomorphic_def by blast
  moreover with assms(1) have "G\<^sub>1 \<simeq> G\<^sub>2'"
    by (metis isomorphic_trans)
  ultimately show "\<exists>G''. G\<^sub>1 \<simeq> G'' \<and> subgraph G'' G\<^sub>3"
    by blast
qed

lemma subgraph_isomorphic_pre_subgraph_closed:
  assumes "uwellformed G\<^sub>1" and "subgraph G\<^sub>1 G\<^sub>2" and "G\<^sub>2 \<sqsubseteq> G\<^sub>3"
  shows "G\<^sub>1 \<sqsubseteq> G\<^sub>3"
unfolding subgraph_isomorphic_def
proof
  show "uwellformed G\<^sub>3"
    using assms unfolding subgraph_isomorphic_def by blast
next
  from assms(3) obtain G\<^sub>2' where "G\<^sub>2 \<simeq> G\<^sub>2'" "subgraph G\<^sub>2' G\<^sub>3"
    unfolding subgraph_isomorphic_def by blast
  then obtain f where bij: "bij_betw f (uverts G\<^sub>2) (uverts G\<^sub>2')" "G\<^sub>2' = map_ugraph f G\<^sub>2"
    unfolding isomorphism_def by blast
  let ?G\<^sub>1' = "map_ugraph f G\<^sub>1"

  have "bij_betw f (uverts G\<^sub>1) (f ` uverts G\<^sub>1)"
    using bij(1) assms(2) unfolding subgraph_def by (auto intro: bij_betw_subset)
  moreover hence "uwellformed ?G\<^sub>1'"
    using map_ugraph_wellformed[OF assms(1)] unfolding bij_betw_def ..
  ultimately have "G\<^sub>1 \<simeq> ?G\<^sub>1'"
    using assms(1) unfolding isomorphism_def by (metis map_ugraph.simps fst_conv surjective_pairing)
  moreover have "subgraph ?G\<^sub>1' G\<^sub>3" (* Yes, I will TOTALLY understand that step tomorrow. *)
    using subgraph_trans[OF map_ugraph_preserves_sub[OF assms(2)]] bij(2) \<open>subgraph G\<^sub>2' G\<^sub>3\<close> by simp
  ultimately show "\<exists>G''. G\<^sub>1 \<simeq> G'' \<and> subgraph G'' G\<^sub>3"
    by blast
qed

lemmas subgraph_isomorphic_pre_closed = subgraph_isomorphic_pre_subgraph_closed subgraph_isomorphic_pre_iso_closed

lemmas subgraph_isomorphic_post_closed = subgraph_isomorphic_post_iso_closed

lemmas subgraph_isomorphic_closed = subgraph_isomorphic_pre_closed subgraph_isomorphic_post_closed

subsection\<open>Density\<close>

text\<open>The density of a graph is the quotient of the number of edges and the number of vertices of
a graph.\<close>

definition density :: "ugraph \<Rightarrow> real" where
"density G = card (uedges G) / card (uverts G)"

text\<open>The maximum density of a graph is the density of its densest nonempty subgraph.\<close>

definition max_density :: "ugraph \<Rightarrow> real" where
"max_density G = Lattices_Big.Max (density ` nonempty_subgraphs G)"

text\<open>We prove some obvious results about the maximum density, such as that there is a subgraph
which has the maximum density and that the (maximum) density is preserved by isomorphisms. The
proofs are a bit complicated by the fact that most facts about @{term Lattices_Big.Max} require
non-emptiness of the target set, but we need that anyway to get a value out of it.\<close>

lemma max_density_is_max:
  assumes "finite_graph G" and "finite_graph G'" and "nonempty_graph G'" and "uwellformed G'" and "subgraph G' G"
  shows "density G' \<le> max_density G"
unfolding max_density_def
proof (rule Max_ge)
  show "finite (density ` nonempty_subgraphs G)"
    using assms(1) by (simp add: nonempty_subgraphs_finite)
next
  show "density G' \<in> density ` nonempty_subgraphs G"
    unfolding nonempty_subgraphs_def using assms by blast
qed

lemma max_density_gr_zero:
  assumes "finite_graph G" and "nonempty_graph G" and "uwellformed G"
  shows "0 < max_density G"
proof -
  have "0 < card (uverts G)" "0 < card (uedges G)"
    using assms unfolding finite_graph_def nonempty_graph_def by auto
  hence "0 < density G"
    unfolding density_def by simp
  also have "density G \<le> max_density G"
    using assms by (simp add: max_density_is_max subgraph_refl)
  finally show ?thesis
    .
qed

lemma isomorphic_density:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2"
  shows "density G\<^sub>1 = density G\<^sub>2"
unfolding density_def
using isomorphic_cards[OF assms]
by simp

lemma isomorphic_max_density:
  assumes "G\<^sub>1 \<simeq> G\<^sub>2" and "nonempty_graph G\<^sub>1" and "nonempty_graph G\<^sub>2" and "finite_graph G\<^sub>1" and "finite_graph G\<^sub>2"
  shows "max_density G\<^sub>1 = max_density G\<^sub>2"
proof -
  \<comment> \<open>The proof strategy is not completely straightforward. We first show that if two graphs are
       isomorphic, the maximum density of one graph is less or equal than the maximum density of
       the other graph. The reason is that this proof is quite long and the desired result directly
       follows from the symmetry of the isomorphism relation.\footnote{Some famous mathematician
       once said that if you prove that $a \le b$ and $b \le a$, you know \emph{that} these
       numbers are equal, but not \emph{why}. Since many proofs in this work are mostly opaque to
       me, I can live with that.}\<close>
  {
    fix A B
    assume A: "nonempty_graph A" "finite_graph A"
    assume iso: "A \<simeq> B"

    then obtain f where f: "B = map_ugraph f A" "bij_betw f (uverts A) (uverts B)"
      unfolding isomorphism_def by blast
    have wellformed: "uwellformed A"
      using iso unfolding isomorphism_def by simp
    \<comment> \<open>We observe that the set of densities of the subgraphs does not change if we map the
         subgraphs first.\<close>
    have "density ` nonempty_subgraphs A = density ` (map_ugraph f ` nonempty_subgraphs A)"
      proof (rule image_comp_cong)
        fix G
        assume "G \<in> nonempty_subgraphs A"
        hence "uverts G \<subseteq> uverts A" "uwellformed G"
          unfolding nonempty_subgraphs_def subgraph_def by simp+
        hence "inj_on f (uverts G)"
          using f(2) unfolding bij_betw_def by (metis subset_inj_on)
        hence "G \<simeq> map_ugraph f G"
          unfolding isomorphism_def bij_betw_def
          by (metis map_ugraph.simps fst_conv surjective_pairing map_ugraph_wellformed \<open>uwellformed G\<close>)
        thus "density G = density (map_ugraph f G)"
          by (fact isomorphic_density)
      qed
    \<comment> \<open>Additionally, we show that the operations @{term nonempty_subgraphs} and @{term map_ugraph}
         can be swapped without changing the densities. This is an obvious result, because
         @{term map_ugraph} does not change the structure of a graph. Still, the proof is a bit
         hairy, which is why we only show inclusion in one direction and use symmetry of isomorphism
         later.\<close>
    also have "\<dots> \<subseteq> density ` nonempty_subgraphs (map_ugraph f A)"
      proof (rule image_mono, rule subsetI)
        fix G''
        assume "G'' \<in> map_ugraph f ` nonempty_subgraphs A"
        then obtain G' where G_subst: "G'' = map_ugraph f G'" "G' \<in> nonempty_subgraphs A"
          by blast
        hence G': "subgraph G' A" "nonempty_graph G'" "uwellformed G'"
          unfolding nonempty_subgraphs_def by auto
        hence "inj_on f (uverts G')"
          using f unfolding bij_betw_def subgraph_def by (metis subset_inj_on)
        hence "uwellformed G''"
          using map_ugraph_wellformed G' G_subst by simp
        moreover have "nonempty_graph G''"
          using G' G_subst unfolding nonempty_graph_def by (metis map_ugraph.simps fst_conv snd_conv surjective_pairing empty_is_image)
        moreover have "subgraph G'' (map_ugraph f A)"
          using map_ugraph_preserves_sub G' G_subst by simp
        ultimately show "G'' \<in> nonempty_subgraphs (map_ugraph f A)"
          unfolding nonempty_subgraphs_def by simp
      qed
    finally have "density ` nonempty_subgraphs A \<subseteq> density ` nonempty_subgraphs (map_ugraph f A)"
      .
    hence "max_density A \<le> max_density (map_ugraph f A)"
      unfolding max_density_def
      proof (rule Max_mono)
        have "A \<in> nonempty_subgraphs A"
          using A iso unfolding nonempty_subgraphs_def by (simp add: subgraph_refl)
        thus "density ` nonempty_subgraphs A \<noteq> {}"
          by blast
      next
        have "finite (nonempty_subgraphs (map_ugraph f A))"
          by (rule nonempty_subgraphs_finite[OF map_ugraph_finite[OF A(2)]])
        thus "finite (density ` nonempty_subgraphs (map_ugraph f A))"
          by blast
      qed
    hence "max_density A \<le> max_density B"
      by (subst f)
  }
  note le = this

  show ?thesis
    using le[OF assms(2) assms(4) assms(1)] le[OF assms(3) assms(5) isomorphic_sym[OF assms(1)]]
    by (fact antisym)
qed

subsection\<open>Fixed selectors\<close>

text\<open>\label{sec:selector}
In the proof of the main theorem in the lecture notes, the concept of a ``fixed copy'' of a graph is
fundamental.

Let $H$ be a fixed graph. A `fixed selector' is basically a function mapping a set with the same
size as the vertex set of $H$ to a new graph which is isomorphic to $H$ and its vertex set is the
same as the input set.\footnote{We call such a selector \emph{fixed} because its result is
deterministic.}\<close>

definition "is_fixed_selector H f = (\<forall>V. finite V \<and> card (uverts H) = card V \<longrightarrow> H \<simeq> f V \<and> uverts (f V) = V)"

text\<open>Obviously, there may be many possible fixed selectors for a given graph. First, we show
that there is always at least one. This is sufficient, because we can always obtain that one and
use its properties without knowing exactly which one we chose.\<close>

lemma ex_fixed_selector:
  assumes "uwellformed H" and "finite_graph H"
  obtains f where "is_fixed_selector H f"
proof
  \<comment> \<open>I guess this is the only place in the whole work where we make use of a nifty little HOL
       feature called \emph{SOME}, which is basically Hilbert's choice operator. The reason is that
       any bijection between the the vertex set of @{term H} and the input set gives rise to a
       fixed selector function. In the lecture notes, a specific bijection was defined, but this
       is shorter and more elegant.\<close>
  let ?bij = "\<lambda>V. SOME g. bij_betw g (uverts H) V"
  let ?f = "\<lambda>V. map_ugraph (?bij V) H"
  {
    fix V :: "uvert set"
    assume "finite V" "card (uverts H) = card V"
    moreover have "finite (uverts H)"
      using assms unfolding finite_graph_def by simp
    ultimately have "bij_betw (?bij V) (uverts H) V"
      by (metis finite_same_card_bij someI_ex)
    moreover hence *: "uverts (?f V) = V \<and> uwellformed (?f V)"
      using map_ugraph_wellformed[OF assms(1)]
      by (metis bij_betw_def map_ugraph.simps fst_conv surjective_pairing)
    ultimately have **: "H \<simeq> ?f V"
      unfolding isomorphism_def using assms(1) by auto
    note * **
  }
  thus "is_fixed_selector H ?f"
    unfolding is_fixed_selector_def by blast
qed

lemma fixed_selector_induced_subgraph:
  assumes "is_fixed_selector H f" and "card (uverts H) = card V" and "finite V"
  assumes sub: "subgraph (f V) (induced_subgraph V G)" and V: "V \<subseteq> uverts G" and G: "uwellformed G"
  shows "H \<sqsubseteq> G"
proof -
  have post: "H \<simeq> f V" "uverts (f V) = V"
    using assms unfolding is_fixed_selector_def by auto

  have "H \<sqsubseteq> f V"
    by (rule isomorphic_is_subgraph_isomorphic)
       (simp add: post)
  also have "f V \<sqsubseteq> induced_subgraph V G"
    by (rule subgraph_is_subgraph_isomorphic)
       (auto simp: induced_wellformed[OF G V] post sub)
  also have "\<dots> \<sqsubseteq> G"
    by (rule subgraph_is_subgraph_isomorphic[OF induced_wellformed])
       (auto simp: G V induced_is_subgraph(1)[OF V])
  finally show "H \<sqsubseteq> G"
    .
qed

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_bin_nat_plus
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

datatype Bin = One | ZeroAnd "Bin" | OneAnd "Bin"

fun s :: "Bin => Bin" where
"s (One) = ZeroAnd One"
| "s (ZeroAnd xs) = OneAnd xs"
| "s (OneAnd ys) = ZeroAnd (s ys)"

fun plus2 :: "Bin => Bin => Bin" where
"plus2 (One) y = s y"
| "plus2 (ZeroAnd z) (One) = s (ZeroAnd z)"
| "plus2 (ZeroAnd z) (ZeroAnd ys) = ZeroAnd (plus2 z ys)"
| "plus2 (ZeroAnd z) (OneAnd xs) = OneAnd (plus2 z xs)"
| "plus2 (OneAnd x2) (One) = s (OneAnd x2)"
| "plus2 (OneAnd x2) (ZeroAnd zs) = OneAnd (plus2 x2 zs)"
| "plus2 (OneAnd x2) (OneAnd ys2) = ZeroAnd (s (plus2 x2 ys2))"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S z) y = S (plus z y)"

fun toNat :: "Bin => Nat" where
"toNat (One) = S Z"
| "toNat (ZeroAnd xs) = plus (toNat xs) (toNat xs)"
| "toNat (OneAnd ys) = plus (plus (S Z) (toNat ys)) (toNat ys)"

theorem property0 :
  "((toNat (plus2 x y)) = (plus (toNat x) (toNat y)))"
  oops

end


(*  Title:      CCL/Gfp.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1992  University of Cambridge
*)

section \<open>Greatest fixed points\<close>

theory Gfp
imports Lfp
begin

definition
  gfp :: "['a set\<Rightarrow>'a set] \<Rightarrow> 'a set" where \<comment> \<open>greatest fixed point\<close>
  "gfp(f) == Union({u. u <= f(u)})"

(* gfp(f) is the least upper bound of {u. u <= f(u)} *)

lemma gfp_upperbound: "A <= f(A) \<Longrightarrow> A <= gfp(f)"
  unfolding gfp_def by blast

lemma gfp_least: "(\<And>u. u <= f(u) \<Longrightarrow> u <= A) \<Longrightarrow> gfp(f) <= A"
  unfolding gfp_def by blast

lemma gfp_lemma2: "mono(f) \<Longrightarrow> gfp(f) <= f(gfp(f))"
  by (rule gfp_least, rule subset_trans, assumption, erule monoD,
    rule gfp_upperbound, assumption)

lemma gfp_lemma3: "mono(f) \<Longrightarrow> f(gfp(f)) <= gfp(f)"
  by (rule gfp_upperbound, frule monoD, rule gfp_lemma2, assumption+)

lemma gfp_Tarski: "mono(f) \<Longrightarrow> gfp(f) = f(gfp(f))"
  by (rule equalityI gfp_lemma2 gfp_lemma3 | assumption)+

(*** Coinduction rules for greatest fixed points ***)

(*weak version*)
lemma coinduct: "\<lbrakk>a: A;  A <= f(A)\<rbrakk> \<Longrightarrow> a : gfp(f)"
  by (blast dest: gfp_upperbound)

lemma coinduct2_lemma: "\<lbrakk>A <= f(A) Un gfp(f); mono(f)\<rbrakk> \<Longrightarrow> A Un gfp(f) <= f(A Un gfp(f))"
  apply (rule subset_trans)
   prefer 2
   apply (erule mono_Un)
  apply (rule subst, erule gfp_Tarski)
  apply (erule Un_least)
  apply (rule Un_upper2)
  done

(*strong version, thanks to Martin Coen*)
lemma coinduct2: "\<lbrakk>a: A; A <= f(A) Un gfp(f); mono(f)\<rbrakk> \<Longrightarrow> a : gfp(f)"
  apply (rule coinduct)
   prefer 2
   apply (erule coinduct2_lemma, assumption)
  apply blast
  done

(***  Even Stronger version of coinduct  [by Martin Coen]
         - instead of the condition  A <= f(A)
                           consider  A <= (f(A) Un f(f(A)) ...) Un gfp(A) ***)

lemma coinduct3_mono_lemma: "mono(f) \<Longrightarrow> mono(\<lambda>x. f(x) Un A Un B)"
  by (rule monoI) (blast dest: monoD)

lemma coinduct3_lemma:
  assumes prem: "A <= f(lfp(\<lambda>x. f(x) Un A Un gfp(f)))"
    and mono: "mono(f)"
  shows "lfp(\<lambda>x. f(x) Un A Un gfp(f)) <= f(lfp(\<lambda>x. f(x) Un A Un gfp(f)))"
  apply (rule subset_trans)
   apply (rule mono [THEN coinduct3_mono_lemma, THEN lfp_lemma3])
  apply (rule Un_least [THEN Un_least])
    apply (rule subset_refl)
   apply (rule prem)
  apply (rule mono [THEN gfp_Tarski, THEN equalityD1, THEN subset_trans])
  apply (rule mono [THEN monoD])
  apply (subst mono [THEN coinduct3_mono_lemma, THEN lfp_Tarski])
  apply (rule Un_upper2)
  done

lemma coinduct3:
  assumes 1: "a:A"
    and 2: "A <= f(lfp(\<lambda>x. f(x) Un A Un gfp(f)))"
    and 3: "mono(f)"
  shows "a : gfp(f)"
  apply (rule coinduct)
   prefer 2
   apply (rule coinduct3_lemma [OF 2 3])
  apply (subst lfp_Tarski [OF coinduct3_mono_lemma, OF 3])
  using 1 apply blast
  done

subsection \<open>Definition forms of \<open>gfp_Tarski\<close>, to control unfolding\<close>

lemma def_gfp_Tarski: "\<lbrakk>h == gfp(f); mono(f)\<rbrakk> \<Longrightarrow> h = f(h)"
  apply unfold
  apply (erule gfp_Tarski)
  done

lemma def_coinduct: "\<lbrakk>h == gfp(f); a:A; A <= f(A)\<rbrakk> \<Longrightarrow> a: h"
  apply unfold
  apply (erule coinduct)
  apply assumption
  done

lemma def_coinduct2: "\<lbrakk>h == gfp(f); a:A; A <= f(A) Un h; mono(f)\<rbrakk> \<Longrightarrow> a: h"
  apply unfold
  apply (erule coinduct2)
   apply assumption
  apply assumption
  done

lemma def_coinduct3: "\<lbrakk>h == gfp(f); a:A; A <= f(lfp(\<lambda>x. f(x) Un A Un h)); mono(f)\<rbrakk> \<Longrightarrow> a: h"
  apply unfold
  apply (erule coinduct3)
   apply assumption
  apply assumption
  done

(*Monotonicity of gfp!*)
lemma gfp_mono: "\<lbrakk>mono(f); \<And>Z. f(Z) <= g(Z)\<rbrakk> \<Longrightarrow> gfp(f) <= gfp(g)"
  apply (rule gfp_upperbound)
  apply (rule subset_trans)
   apply (rule gfp_lemma2)
   apply assumption
  apply (erule meta_spec)
  done

end