(*  Title:      HOL/Algebra/Ring.thy
    Author:     Clemens Ballarin, started 9 December 1996

With contributions by Martin Baillon.
*)

theory Ring
imports FiniteProduct
begin

section \<open>The Algebraic Hierarchy of Rings\<close>

subsection \<open>Abelian Groups\<close>

record 'a ring = "'a monoid" +
  zero :: 'a ("\<zero>\<index>")
  add :: "['a, 'a] \<Rightarrow> 'a" (infixl "\<oplus>\<index>" 65)

abbreviation
  add_monoid :: "('a, 'm) ring_scheme \<Rightarrow> ('a, 'm) monoid_scheme"
  where "add_monoid R \<equiv> \<lparr> carrier = carrier R, mult = add R, one = zero R, \<dots> = (undefined :: 'm) \<rparr>"

text \<open>Derived operations.\<close>

definition
  a_inv :: "[('a, 'm) ring_scheme, 'a ] \<Rightarrow> 'a" ("\<ominus>\<index> _" [81] 80)
  where "a_inv R = m_inv (add_monoid R)"

definition
  a_minus :: "[('a, 'm) ring_scheme, 'a, 'a] => 'a" ("(_ \<ominus>\<index> _)" [65,66] 65)
  where "x \<ominus>\<^bsub>R\<^esub> y = x \<oplus>\<^bsub>R\<^esub> (\<ominus>\<^bsub>R\<^esub> y)"

definition
  add_pow :: "[_, ('b :: semiring_1), 'a] \<Rightarrow> 'a" ("[_] \<cdot>\<index> _" [81, 81] 80)
  where "add_pow R k a = pow (add_monoid R) a k"

locale abelian_monoid =
  fixes G (structure)
  assumes a_comm_monoid:
     "comm_monoid (add_monoid G)"

definition
  finsum :: "[('b, 'm) ring_scheme, 'a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b" where
  "finsum G = finprod (add_monoid G)"

syntax
  "_finsum" :: "index \<Rightarrow> idt \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"
      ("(3\<Oplus>__\<in>_. _)" [1000, 0, 51, 10] 10)
translations
  "\<Oplus>\<^bsub>G\<^esub>i\<in>A. b" \<rightleftharpoons> "CONST finsum G (\<lambda>i. b) A"
  \<comment> \<open>Beware of argument permutation!\<close>

locale abelian_group = abelian_monoid +
  assumes a_comm_group:
     "comm_group (add_monoid G)"

subsection \<open>Basic Properties\<close>

lemma abelian_monoidI:
  fixes R (structure)
  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
      and "\<zero> \<in> carrier R"
      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
  shows "abelian_monoid R"
  by (auto intro!: abelian_monoid.intro comm_monoidI intro: assms)

lemma abelian_monoidE:
  fixes R (structure)
  assumes "abelian_monoid R"
  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
    and "\<zero> \<in> carrier R"
    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
  using assms unfolding abelian_monoid_def comm_monoid_def comm_monoid_axioms_def monoid_def by auto

lemma abelian_groupI:
  fixes R (structure)
  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
      and "\<zero> \<in> carrier R"
      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
  shows "abelian_group R"
  by (auto intro!: abelian_group.intro abelian_monoidI
      abelian_group_axioms.intro comm_monoidI comm_groupI
    intro: assms)

lemma abelian_groupE:
  fixes R (structure)
  assumes "abelian_group R"
  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
    and "\<zero> \<in> carrier R"
    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
  using abelian_group.a_comm_group assms comm_groupE by fastforce+

lemma (in abelian_monoid) a_monoid:
  "monoid (add_monoid G)"
by (rule comm_monoid.axioms, rule a_comm_monoid)

lemma (in abelian_group) a_group:
  "group (add_monoid G)"
  by (simp add: group_def a_monoid)
    (simp add: comm_group.axioms group.axioms a_comm_group)

lemmas monoid_record_simps = partial_object.simps monoid.simps

text \<open>Transfer facts from multiplicative structures via interpretation.\<close>

sublocale abelian_monoid <
       add: monoid "(add_monoid G)"
  rewrites "carrier (add_monoid G) = carrier G"
       and "mult    (add_monoid G) = add G"
       and "one     (add_monoid G) = zero G"
       and "(\<lambda>a k. pow (add_monoid G) a k) = (\<lambda>a k. add_pow G k a)"
  by (rule a_monoid) (auto simp add: add_pow_def)

context abelian_monoid
begin

lemmas a_closed = add.m_closed
lemmas zero_closed = add.one_closed
lemmas a_assoc = add.m_assoc
lemmas l_zero = add.l_one
lemmas r_zero = add.r_one
lemmas minus_unique = add.inv_unique

end

sublocale abelian_monoid <
  add: comm_monoid "(add_monoid G)"
  rewrites "carrier (add_monoid G) = carrier G"
       and "mult    (add_monoid G) = add G"
       and "one     (add_monoid G) = zero G"
       and "finprod (add_monoid G) = finsum G"
       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  by (rule a_comm_monoid) (auto simp: finsum_def add_pow_def)

context abelian_monoid begin

lemmas a_comm = add.m_comm
lemmas a_lcomm = add.m_lcomm
lemmas a_ac = a_assoc a_comm a_lcomm

lemmas finsum_empty = add.finprod_empty
lemmas finsum_insert = add.finprod_insert
lemmas finsum_zero = add.finprod_one
lemmas finsum_closed = add.finprod_closed
lemmas finsum_Un_Int = add.finprod_Un_Int
lemmas finsum_Un_disjoint = add.finprod_Un_disjoint
lemmas finsum_addf = add.finprod_multf
lemmas finsum_cong' = add.finprod_cong'
lemmas finsum_0 = add.finprod_0
lemmas finsum_Suc = add.finprod_Suc
lemmas finsum_Suc2 = add.finprod_Suc2
lemmas finsum_infinite = add.finprod_infinite

lemmas finsum_cong = add.finprod_cong
text \<open>Usually, if this rule causes a failed congruence proof error,
   the reason is that the premise \<open>g \<in> B \<rightarrow> carrier G\<close> cannot be shown.
   Adding @{thm [source] Pi_def} to the simpset is often useful.\<close>

lemmas finsum_reindex = add.finprod_reindex

(* The following would be wrong.  Needed is the equivalent of [^] for addition,
  or indeed the canonical embedding from Nat into the monoid.

lemma finsum_const:
  assumes fin [simp]: "finite A"
      and a [simp]: "a : carrier G"
    shows "finsum G (%x. a) A = a [^] card A"
  using fin apply induct
  apply force
  apply (subst finsum_insert)
  apply auto
  apply (force simp add: Pi_def)
  apply (subst m_comm)
  apply auto
done
*)

lemmas finsum_singleton = add.finprod_singleton

end

sublocale abelian_group <
        add: group "(add_monoid G)"
  rewrites "carrier (add_monoid G) = carrier G"
       and "mult    (add_monoid G) = add G"
       and "one     (add_monoid G) = zero G"
       and "m_inv   (add_monoid G) = a_inv G"
       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  by (rule a_group) (auto simp: m_inv_def a_inv_def add_pow_def)

context abelian_group
begin

lemmas a_inv_closed = add.inv_closed

lemma minus_closed [intro, simp]:
  "[| x \<in> carrier G; y \<in> carrier G |] ==> x \<ominus> y \<in> carrier G"
  by (simp add: a_minus_def)

lemmas l_neg = add.l_inv [simp del]
lemmas r_neg = add.r_inv [simp del]
lemmas minus_minus = add.inv_inv
lemmas a_inv_inj = add.inv_inj
lemmas minus_equality = add.inv_equality

end

sublocale abelian_group <
   add: comm_group "(add_monoid G)"
  rewrites "carrier (add_monoid G) = carrier G"
       and "mult    (add_monoid G) = add G"
       and "one     (add_monoid G) = zero G"
       and "m_inv   (add_monoid G) = a_inv G"
       and "finprod (add_monoid G) = finsum G"
       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  by (rule a_comm_group) (auto simp: m_inv_def a_inv_def finsum_def add_pow_def)

lemmas (in abelian_group) minus_add = add.inv_mult

text \<open>Derive an \<open>abelian_group\<close> from a \<open>comm_group\<close>\<close>

lemma comm_group_abelian_groupI:
  fixes G (structure)
  assumes cg: "comm_group (add_monoid G)"
  shows "abelian_group G"
proof -
  interpret comm_group "(add_monoid G)"
    by (rule cg)
  show "abelian_group G" ..
qed

subsection \<open>Rings: Basic Definitions\<close>

locale semiring = abelian_monoid (* for add *) R + monoid (* for mult *) R for R (structure) +
  assumes l_distr: "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
      and r_distr: "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
      and l_null[simp]: "x \<in> carrier R \<Longrightarrow> \<zero> \<otimes> x = \<zero>"
      and r_null[simp]: "x \<in> carrier R \<Longrightarrow> x \<otimes> \<zero> = \<zero>"

locale ring = abelian_group (* for add *) R + monoid (* for mult *) R for R (structure) +
  assumes "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
      and "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"

locale cring = ring + comm_monoid (* for mult *) R

locale "domain" = cring +
  assumes one_not_zero [simp]: "\<one> \<noteq> \<zero>"
      and integral: "\<lbrakk> a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> a = \<zero> \<or> b = \<zero>"

locale field = "domain" +
  assumes field_Units: "Units R = carrier R - {\<zero>}"

subsection \<open>Rings\<close>

lemma ringI:
  fixes R (structure)
  assumes "abelian_group R"
      and "monoid R"
      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  shows "ring R"
  by (auto intro: ring.intro
    abelian_group.axioms ring_axioms.intro assms)

lemma ringE:
  fixes R (structure)
  assumes "ring R"
  shows "abelian_group R"
    and "monoid R"
    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  using assms unfolding ring_def ring_axioms_def by auto

context ring begin

lemma is_abelian_group: "abelian_group R" ..

lemma is_monoid: "monoid R"
  by (auto intro!: monoidI m_assoc)

end

thm monoid_record_simps
lemmas ring_record_simps = monoid_record_simps ring.simps

lemma cringI:
  fixes R (structure)
  assumes abelian_group: "abelian_group R"
    and comm_monoid: "comm_monoid R"
    and l_distr: "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow>
                            (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  shows "cring R"
proof (intro cring.intro ring.intro)
  show "ring_axioms R"
    \<comment> \<open>Right-distributivity follows from left-distributivity and
          commutativity.\<close>
  proof (rule ring_axioms.intro)
    fix x y z
    assume R: "x \<in> carrier R" "y \<in> carrier R" "z \<in> carrier R"
    note [simp] = comm_monoid.axioms [OF comm_monoid]
      abelian_group.axioms [OF abelian_group]
      abelian_monoid.a_closed

    from R have "z \<otimes> (x \<oplus> y) = (x \<oplus> y) \<otimes> z"
      by (simp add: comm_monoid.m_comm [OF comm_monoid.intro])
    also from R have "... = x \<otimes> z \<oplus> y \<otimes> z" by (simp add: l_distr)
    also from R have "... = z \<otimes> x \<oplus> z \<otimes> y"
      by (simp add: comm_monoid.m_comm [OF comm_monoid.intro])
    finally show "z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y" .
  qed (rule l_distr)
qed (auto intro: cring.intro
  abelian_group.axioms comm_monoid.axioms ring_axioms.intro assms)

lemma cringE:
  fixes R (structure)
  assumes "cring R"
  shows "comm_monoid R"
    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  using assms cring_def by auto (simp add: assms cring.axioms(1) ringE(3))

lemma (in cring) is_cring:
  "cring R" by (rule cring_axioms)

lemma (in ring) minus_zero [simp]: "\<ominus> \<zero> = \<zero>"
  by (simp add: a_inv_def)

subsubsection \<open>Normaliser for Rings\<close>

lemma (in abelian_group) r_neg1:
  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> (\<ominus> x) \<oplus> (x \<oplus> y) = y"
proof -
  assume G: "x \<in> carrier G" "y \<in> carrier G"
  then have "(\<ominus> x \<oplus> x) \<oplus> y = y"
    by (simp only: l_neg l_zero)
  with G show ?thesis by (simp add: a_ac)
qed

lemma (in abelian_group) r_neg2:
  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<oplus> ((\<ominus> x) \<oplus> y) = y"
proof -
  assume G: "x \<in> carrier G" "y \<in> carrier G"
  then have "(x \<oplus> \<ominus> x) \<oplus> y = y"
    by (simp only: r_neg l_zero)
  with G show ?thesis
    by (simp add: a_ac)
qed

context ring begin

text \<open>
  The following proofs are from Jacobson, Basic Algebra I, pp.~88--89.
\<close>

sublocale semiring
proof -
  note [simp] = ring_axioms[unfolded ring_def ring_axioms_def]
  show "semiring R"
  proof (unfold_locales)
    fix x
    assume R: "x \<in> carrier R"
    then have "\<zero> \<otimes> x \<oplus> \<zero> \<otimes> x = (\<zero> \<oplus> \<zero>) \<otimes> x"
      by (simp del: l_zero r_zero)
    also from R have "... = \<zero> \<otimes> x \<oplus> \<zero>" by simp
    finally have "\<zero> \<otimes> x \<oplus> \<zero> \<otimes> x = \<zero> \<otimes> x \<oplus> \<zero>" .
    with R show "\<zero> \<otimes> x = \<zero>" by (simp del: r_zero)
    from R have "x \<otimes> \<zero> \<oplus> x \<otimes> \<zero> = x \<otimes> (\<zero> \<oplus> \<zero>)"
      by (simp del: l_zero r_zero)
    also from R have "... = x \<otimes> \<zero> \<oplus> \<zero>" by simp
    finally have "x \<otimes> \<zero> \<oplus> x \<otimes> \<zero> = x \<otimes> \<zero> \<oplus> \<zero>" .
    with R show "x \<otimes> \<zero> = \<zero>" by (simp del: r_zero)
  qed auto
qed

lemma l_minus:
  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> (\<ominus> x) \<otimes> y = \<ominus> (x \<otimes> y)"
proof -
  assume R: "x \<in> carrier R" "y \<in> carrier R"
  then have "(\<ominus> x) \<otimes> y \<oplus> x \<otimes> y = (\<ominus> x \<oplus> x) \<otimes> y" by (simp add: l_distr)
  also from R have "... = \<zero>" by (simp add: l_neg)
  finally have "(\<ominus> x) \<otimes> y \<oplus> x \<otimes> y = \<zero>" .
  with R have "(\<ominus> x) \<otimes> y \<oplus> x \<otimes> y \<oplus> \<ominus> (x \<otimes> y) = \<zero> \<oplus> \<ominus> (x \<otimes> y)" by simp
  with R show ?thesis by (simp add: a_assoc r_neg)
qed

lemma r_minus:
  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<otimes> (\<ominus> y) = \<ominus> (x \<otimes> y)"
proof -
  assume R: "x \<in> carrier R" "y \<in> carrier R"
  then have "x \<otimes> (\<ominus> y) \<oplus> x \<otimes> y = x \<otimes> (\<ominus> y \<oplus> y)" by (simp add: r_distr)
  also from R have "... = \<zero>" by (simp add: l_neg)
  finally have "x \<otimes> (\<ominus> y) \<oplus> x \<otimes> y = \<zero>" .
  with R have "x \<otimes> (\<ominus> y) \<oplus> x \<otimes> y \<oplus> \<ominus> (x \<otimes> y) = \<zero> \<oplus> \<ominus> (x \<otimes> y)" by simp
  with R show ?thesis by (simp add: a_assoc r_neg )
qed

end

lemma (in abelian_group) minus_eq: "x \<ominus> y = x \<oplus> (\<ominus> y)"
  by (rule a_minus_def)

text \<open>Setup algebra method:
  compute distributive normal form in locale contexts\<close>

ML_file \<open>ringsimp.ML\<close>

attribute_setup algebra = \<open>
  Scan.lift ((Args.add >> K true || Args.del >> K false) --| Args.colon || Scan.succeed true)
    -- Scan.lift Args.name -- Scan.repeat Args.term
    >> (fn ((b, n), ts) => if b then Ringsimp.add_struct (n, ts) else Ringsimp.del_struct (n, ts))
\<close> "theorems controlling algebra method"

method_setup algebra = \<open>
  Scan.succeed (SIMPLE_METHOD' o Ringsimp.algebra_tac)
\<close> "normalisation of algebraic structure"

lemmas (in semiring) semiring_simprules
  [algebra ring "zero R" "add R" "a_inv R" "a_minus R" "one R" "mult R"] =
  a_closed zero_closed  m_closed one_closed
  a_assoc l_zero  a_comm m_assoc l_one l_distr r_zero
  a_lcomm r_distr l_null r_null

lemmas (in ring) ring_simprules
  [algebra ring "zero R" "add R" "a_inv R" "a_minus R" "one R" "mult R"] =
  a_closed zero_closed a_inv_closed minus_closed m_closed one_closed
  a_assoc l_zero l_neg a_comm m_assoc l_one l_distr minus_eq
  r_zero r_neg r_neg2 r_neg1 minus_add minus_minus minus_zero
  a_lcomm r_distr l_null r_null l_minus r_minus

lemmas (in cring)
  [algebra del: ring "zero R" "add R" "a_inv R" "a_minus R" "one R" "mult R"] =
  _

lemmas (in cring) cring_simprules
  [algebra add: cring "zero R" "add R" "a_inv R" "a_minus R" "one R" "mult R"] =
  a_closed zero_closed a_inv_closed minus_closed m_closed one_closed
  a_assoc l_zero l_neg a_comm m_assoc l_one l_distr m_comm minus_eq
  r_zero r_neg r_neg2 r_neg1 minus_add minus_minus minus_zero
  a_lcomm m_lcomm r_distr l_null r_null l_minus r_minus

lemma (in semiring) nat_pow_zero:
  "(n::nat) \<noteq> 0 \<Longrightarrow> \<zero> [^] n = \<zero>"
  by (induct n) simp_all

context semiring begin

lemma one_zeroD:
  assumes onezero: "\<one> = \<zero>"
  shows "carrier R = {\<zero>}"
proof (rule, rule)
  fix x
  assume xcarr: "x \<in> carrier R"
  from xcarr have "x = x \<otimes> \<one>" by simp
  with onezero have "x = x \<otimes> \<zero>" by simp
  with xcarr have "x = \<zero>" by simp
  then show "x \<in> {\<zero>}" by fast
qed fast

lemma one_zeroI:
  assumes carrzero: "carrier R = {\<zero>}"
  shows "\<one> = \<zero>"
proof -
  from one_closed and carrzero
      show "\<one> = \<zero>" by simp
qed

lemma carrier_one_zero: "(carrier R = {\<zero>}) = (\<one> = \<zero>)"
  using one_zeroD by blast

lemma carrier_one_not_zero: "(carrier R \<noteq> {\<zero>}) = (\<one> \<noteq> \<zero>)"
  by (simp add: carrier_one_zero)

end

text \<open>Two examples for use of method algebra\<close>

lemma
  fixes R (structure) and S (structure)
  assumes "ring R" "cring S"
  assumes RS: "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier S" "d \<in> carrier S"
  shows "a \<oplus> (\<ominus> (a \<oplus> (\<ominus> b))) = b \<and> c \<otimes>\<^bsub>S\<^esub> d = d \<otimes>\<^bsub>S\<^esub> c"
proof -
  interpret ring R by fact
  interpret cring S by fact
  from RS show ?thesis by algebra
qed

lemma
  fixes R (structure)
  assumes "ring R"
  assumes R: "a \<in> carrier R" "b \<in> carrier R"
  shows "a \<ominus> (a \<ominus> b) = b"
proof -
  interpret ring R by fact
  from R show ?thesis by algebra
qed

subsubsection \<open>Sums over Finite Sets\<close>

lemma (in semiring) finsum_ldistr:
  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
    (\<Oplus> i \<in> A. (f i)) \<otimes> a = (\<Oplus> i \<in> A. ((f i) \<otimes> a))"
proof (induct set: finite)
  case empty then show ?case by simp
next
  case (insert x F) then show ?case by (simp add: Pi_def l_distr)
qed

lemma (in semiring) finsum_rdistr:
  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
   a \<otimes> (\<Oplus> i \<in> A. (f i)) = (\<Oplus> i \<in> A. (a \<otimes> (f i)))"
proof (induct set: finite)
  case empty then show ?case by simp
next
  case (insert x F) then show ?case by (simp add: Pi_def r_distr)
qed

text \<open>A quick detour\<close>

lemma add_pow_int_ge: "(k :: int) \<ge> 0 \<Longrightarrow> [ k ] \<cdot>\<^bsub>R\<^esub> a = [ nat k ] \<cdot>\<^bsub>R\<^esub> a" \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  by (simp add: add_pow_def int_pow_def nat_pow_def)

lemma add_pow_int_lt: "(k :: int) < 0 \<Longrightarrow> [ k ] \<cdot>\<^bsub>R\<^esub> a = \<ominus>\<^bsub>R\<^esub> ([ nat (- k) ] \<cdot>\<^bsub>R\<^esub> a)" \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  by (simp add: int_pow_def nat_pow_def a_inv_def add_pow_def)

corollary (in semiring) add_pow_ldistr: \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  assumes "a \<in> carrier R" "b \<in> carrier R"
  shows "([(k :: nat)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
proof -
  have "([k] \<cdot> a) \<otimes> b = (\<Oplus> i \<in> {..< k}. a) \<otimes> b"
    using add.finprod_const[OF assms(1), of "{..<k}"] by simp
  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
    using finsum_ldistr[of "{..<k}" b "\<lambda>x. a"] assms by simp
  also have " ... = [k] \<cdot> (a \<otimes> b)"
    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
  finally show ?thesis .
qed

corollary (in semiring) add_pow_rdistr: \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  assumes "a \<in> carrier R" "b \<in> carrier R"
  shows "a \<otimes> ([(k :: nat)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
proof -
  have "a \<otimes> ([k] \<cdot> b) = a \<otimes> (\<Oplus> i \<in> {..< k}. b)"
    using add.finprod_const[OF assms(2), of "{..<k}"] by simp
  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
    using finsum_rdistr[of "{..<k}" a "\<lambda>x. b"] assms by simp
  also have " ... = [k] \<cdot> (a \<otimes> b)"
    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
  finally show ?thesis .
qed

(* For integers, we need the uniqueness of the additive inverse *)
lemma (in ring) add_pow_ldistr_int: \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  assumes "a \<in> carrier R" "b \<in> carrier R"
  shows "([(k :: int)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
proof (cases "k \<ge> 0")
  case True thus ?thesis
    using add_pow_int_ge[of k R] add_pow_ldistr[OF assms] by auto
next
  case False thus ?thesis
    using add_pow_int_lt[of k R a] add_pow_int_lt[of k R "a \<otimes> b"]
          add_pow_ldistr[OF assms, of "nat (- k)"] assms l_minus by auto
qed

lemma (in ring) add_pow_rdistr_int: \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  assumes "a \<in> carrier R" "b \<in> carrier R"
  shows "a \<otimes> ([(k :: int)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
proof (cases "k \<ge> 0")
  case True thus ?thesis
    using add_pow_int_ge[of k R] add_pow_rdistr[OF assms] by auto
next
  case False thus ?thesis
    using add_pow_int_lt[of k R b] add_pow_int_lt[of k R "a \<otimes> b"]
          add_pow_rdistr[OF assms, of "nat (- k)"] assms r_minus by auto
qed

subsection \<open>Integral Domains\<close>

context "domain" begin

lemma zero_not_one [simp]: "\<zero> \<noteq> \<one>"
  by (rule not_sym) simp

lemma integral_iff: (* not by default a simp rule! *)
  "\<lbrakk> a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> (a \<otimes> b = \<zero>) = (a = \<zero> \<or> b = \<zero>)"
proof
  assume "a \<in> carrier R" "b \<in> carrier R" "a \<otimes> b = \<zero>"
  then show "a = \<zero> \<or> b = \<zero>" by (simp add: integral)
next
  assume "a \<in> carrier R" "b \<in> carrier R" "a = \<zero> \<or> b = \<zero>"
  then show "a \<otimes> b = \<zero>" by auto
qed

lemma m_lcancel:
  assumes prem: "a \<noteq> \<zero>"
    and R: "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
  shows "(a \<otimes> b = a \<otimes> c) = (b = c)"
proof
  assume eq: "a \<otimes> b = a \<otimes> c"
  with R have "a \<otimes> (b \<ominus> c) = \<zero>" by algebra
  with R have "a = \<zero> \<or> (b \<ominus> c) = \<zero>" by (simp add: integral_iff)
  with prem and R have "b \<ominus> c = \<zero>" by auto
  with R have "b = b \<ominus> (b \<ominus> c)" by algebra
  also from R have "b \<ominus> (b \<ominus> c) = c" by algebra
  finally show "b = c" .
next
  assume "b = c" then show "a \<otimes> b = a \<otimes> c" by simp
qed

lemma m_rcancel:
  assumes prem: "a \<noteq> \<zero>"
    and R: "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
  shows conc: "(b \<otimes> a = c \<otimes> a) = (b = c)"
proof -
  from prem and R have "(a \<otimes> b = a \<otimes> c) = (b = c)" by (rule m_lcancel)
  with R show ?thesis by algebra
qed

end

subsection \<open>Fields\<close>

text \<open>Field would not need to be derived from domain, the properties
  for domain follow from the assumptions of field\<close>

lemma (in field) is_ring: "ring R"
  using ring_axioms .

lemma fieldE :
  fixes R (structure)
  assumes "field R"
  shows "cring R"
    and one_not_zero : "\<one> \<noteq> \<zero>"
    and integral: "\<And>a b. \<lbrakk> a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> a = \<zero> \<or> b = \<zero>"
  and field_Units: "Units R = carrier R - {\<zero>}"
  using assms unfolding field_def field_axioms_def domain_def domain_axioms_def by simp_all

lemma (in cring) cring_fieldI:
  assumes field_Units: "Units R = carrier R - {\<zero>}"
  shows "field R"
proof
  from field_Units have "\<zero> \<notin> Units R" by fast
  moreover have "\<one> \<in> Units R" by fast
  ultimately show "\<one> \<noteq> \<zero>" by force
next
  fix a b
  assume acarr: "a \<in> carrier R"
    and bcarr: "b \<in> carrier R"
    and ab: "a \<otimes> b = \<zero>"
  show "a = \<zero> \<or> b = \<zero>"
  proof (cases "a = \<zero>", simp)
    assume "a \<noteq> \<zero>"
    with field_Units and acarr have aUnit: "a \<in> Units R" by fast
    from bcarr have "b = \<one> \<otimes> b" by algebra
    also from aUnit acarr have "... = (inv a \<otimes> a) \<otimes> b" by simp
    also from acarr bcarr aUnit[THEN Units_inv_closed]
    have "... = (inv a) \<otimes> (a \<otimes> b)" by algebra
    also from ab and acarr bcarr aUnit have "... = (inv a) \<otimes> \<zero>" by simp
    also from aUnit[THEN Units_inv_closed] have "... = \<zero>" by algebra
    finally have "b = \<zero>" .
    then show "a = \<zero> \<or> b = \<zero>" by simp
  qed
qed (rule field_Units)

text \<open>Another variant to show that something is a field\<close>
lemma (in cring) cring_fieldI2:
  assumes notzero: "\<zero> \<noteq> \<one>"
    and invex: "\<And>a. \<lbrakk>a \<in> carrier R; a \<noteq> \<zero>\<rbrakk> \<Longrightarrow> \<exists>b\<in>carrier R. a \<otimes> b = \<one>"
  shows "field R"
proof -
  have *: "carrier R - {\<zero>} \<subseteq> {y \<in> carrier R. \<exists>x\<in>carrier R. x \<otimes> y = \<one> \<and> y \<otimes> x = \<one>}"
  proof (clarsimp)
    fix x
    assume xcarr: "x \<in> carrier R" and "x \<noteq> \<zero>"
    obtain y where ycarr: "y \<in> carrier R" and xy: "x \<otimes> y = \<one>"
      using \<open>x \<noteq> \<zero>\<close> invex xcarr by blast
    with ycarr and xy show "\<exists>y\<in>carrier R. y \<otimes> x = \<one> \<and> x \<otimes> y = \<one>"
      using m_comm xcarr by fastforce
  qed
  show ?thesis
    apply (rule cring_fieldI, simp add: Units_def)
    using *
    using group_l_invI notzero set_diff_eq by auto
qed

subsection \<open>Morphisms\<close>

definition
  ring_hom :: "[('a, 'm) ring_scheme, ('b, 'n) ring_scheme] => ('a => 'b) set"
  where "ring_hom R S =
    {h. h \<in> carrier R \<rightarrow> carrier S \<and>
      (\<forall>x y. x \<in> carrier R \<and> y \<in> carrier R \<longrightarrow>
        h (x \<otimes>\<^bsub>R\<^esub> y) = h x \<otimes>\<^bsub>S\<^esub> h y \<and> h (x \<oplus>\<^bsub>R\<^esub> y) = h x \<oplus>\<^bsub>S\<^esub> h y) \<and>
      h \<one>\<^bsub>R\<^esub> = \<one>\<^bsub>S\<^esub>}"

lemma ring_hom_memI:
  fixes R (structure) and S (structure)
  assumes "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
      and "h \<one> = \<one>\<^bsub>S\<^esub>"
  shows "h \<in> ring_hom R S"
  by (auto simp add: ring_hom_def assms Pi_def)

lemma ring_hom_memE:
  fixes R (structure) and S (structure)
  assumes "h \<in> ring_hom R S"
  shows "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
    and "h \<one> = \<one>\<^bsub>S\<^esub>"
  using assms unfolding ring_hom_def by auto

lemma ring_hom_closed:
  "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R \<rbrakk> \<Longrightarrow> h x \<in> carrier S"
  by (auto simp add: ring_hom_def funcset_mem)

lemma ring_hom_mult:
  fixes R (structure) and S (structure)
  shows "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
    by (simp add: ring_hom_def)

lemma ring_hom_add:
  fixes R (structure) and S (structure)
  shows "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
    by (simp add: ring_hom_def)

lemma ring_hom_one:
  fixes R (structure) and S (structure)
  shows "h \<in> ring_hom R S \<Longrightarrow> h \<one> = \<one>\<^bsub>S\<^esub>"
  by (simp add: ring_hom_def)

lemma ring_hom_zero:
  fixes R (structure) and S (structure)
  assumes "h \<in> ring_hom R S" "ring R" "ring S"
  shows "h \<zero> = \<zero>\<^bsub>S\<^esub>"
proof -
  have "h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero>"
    using ring_hom_add[OF assms(1), of \<zero> \<zero>] assms(2)
    by (simp add: ring.ring_simprules(2) ring.ring_simprules(15))
  thus ?thesis
    by (metis abelian_group.l_neg assms ring.is_abelian_group ring.ring_simprules(18) ring.ring_simprules(2) ring_hom_closed)
qed

locale ring_hom_cring =
  R?: cring R + S?: cring S for R (structure) and S (structure) + fixes h
  assumes homh [simp, intro]: "h \<in> ring_hom R S"
  notes hom_closed [simp, intro] = ring_hom_closed [OF homh]
    and hom_mult [simp] = ring_hom_mult [OF homh]
    and hom_add [simp] = ring_hom_add [OF homh]
    and hom_one [simp] = ring_hom_one [OF homh]

lemma (in ring_hom_cring) hom_zero [simp]: "h \<zero> = \<zero>\<^bsub>S\<^esub>"
proof -
  have "h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> \<zero>\<^bsub>S\<^esub>"
    by (simp add: hom_add [symmetric] del: hom_add)
  then show ?thesis by (simp del: S.r_zero)
qed

lemma (in ring_hom_cring) hom_a_inv [simp]:
  "x \<in> carrier R \<Longrightarrow> h (\<ominus> x) = \<ominus>\<^bsub>S\<^esub> h x"
proof -
  assume R: "x \<in> carrier R"
  then have "h x \<oplus>\<^bsub>S\<^esub> h (\<ominus> x) = h x \<oplus>\<^bsub>S\<^esub> (\<ominus>\<^bsub>S\<^esub> h x)"
    by (simp add: hom_add [symmetric] R.r_neg S.r_neg del: hom_add)
  with R show ?thesis by simp
qed

lemma (in ring_hom_cring) hom_finsum [simp]:
  assumes "f: A \<rightarrow> carrier R"
  shows "h (\<Oplus> i \<in> A. f i) = (\<Oplus>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)

lemma (in ring_hom_cring) hom_finprod:
  assumes "f: A \<rightarrow> carrier R"
  shows "h (\<Otimes> i \<in> A. f i) = (\<Otimes>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)

declare ring_hom_cring.hom_finprod [simp]

lemma id_ring_hom [simp]: "id \<in> ring_hom R R"
  by (auto intro!: ring_hom_memI)

lemma ring_hom_trans: \<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close>
  "\<lbrakk> f \<in> ring_hom R S; g \<in> ring_hom S T \<rbrakk> \<Longrightarrow> g \<circ> f \<in> ring_hom R T"
  by (rule ring_hom_memI) (auto simp add: ring_hom_closed ring_hom_mult ring_hom_add ring_hom_one)

subsection\<open>Jeremy Avigad's \<open>More_Finite_Product\<close> material\<close>

(* need better simplification rules for rings *)
(* the next one holds more generally for abelian groups *)

lemma (in cring) sum_zero_eq_neg: "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> x \<oplus> y = \<zero> \<Longrightarrow> x = \<ominus> y"
  by (metis minus_equality)

lemma (in domain) square_eq_one:
  fixes x
  assumes [simp]: "x \<in> carrier R"
    and "x \<otimes> x = \<one>"
  shows "x = \<one> \<or> x = \<ominus>\<one>"
proof -
  have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = x \<otimes> x \<oplus> \<ominus> \<one>"
    by (simp add: ring_simprules)
  also from \<open>x \<otimes> x = \<one>\<close> have "\<dots> = \<zero>"
    by (simp add: ring_simprules)
  finally have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = \<zero>" .
  then have "(x \<oplus> \<one>) = \<zero> \<or> (x \<oplus> \<ominus> \<one>) = \<zero>"
    by (intro integral) auto
  then show ?thesis
    by (metis add.inv_closed add.inv_solve_right assms(1) l_zero one_closed zero_closed)
qed

lemma (in domain) inv_eq_self: "x \<in> Units R \<Longrightarrow> x = inv x \<Longrightarrow> x = \<one> \<or> x = \<ominus>\<one>"
  by (metis Units_closed Units_l_inv square_eq_one)

text \<open>
  The following translates theorems about groups to the facts about
  the units of a ring. (The list should be expanded as more things are
  needed.)
\<close>

lemma (in ring) finite_ring_finite_units [intro]: "finite (carrier R) \<Longrightarrow> finite (Units R)"
  by (rule finite_subset) auto

lemma (in monoid) units_of_pow:
  fixes n :: nat
  shows "x \<in> Units G \<Longrightarrow> x [^]\<^bsub>units_of G\<^esub> n = x [^]\<^bsub>G\<^esub> n"
  apply (induct n)
  apply (auto simp add: units_group group.is_monoid
    monoid.nat_pow_0 monoid.nat_pow_Suc units_of_one units_of_mult)
  done

lemma (in cring) units_power_order_eq_one:
  "finite (Units R) \<Longrightarrow> a \<in> Units R \<Longrightarrow> a [^] card(Units R) = \<one>"
  by (metis comm_group.power_order_eq_one units_comm_group units_of_carrier units_of_one units_of_pow)

subsection\<open>Jeremy Avigad's \<open>More_Ring\<close> material\<close>

lemma (in cring) field_intro2:
  assumes "\<zero>\<^bsub>R\<^esub> \<noteq> \<one>\<^bsub>R\<^esub>" and un: "\<And>x. x \<in> carrier R - {\<zero>\<^bsub>R\<^esub>} \<Longrightarrow> x \<in> Units R"
  shows "field R"
proof unfold_locales
  show "\<one> \<noteq> \<zero>" using assms by auto
  show "\<lbrakk>a \<otimes> b = \<zero>; a \<in> carrier R;
            b \<in> carrier R\<rbrakk>
           \<Longrightarrow> a = \<zero> \<or> b = \<zero>" for a b
    by (metis un Units_l_cancel insert_Diff_single insert_iff r_null zero_closed)
qed (use assms in \<open>auto simp: Units_def\<close>)

lemma (in monoid) inv_char:
  assumes "x \<in> carrier G" "y \<in> carrier G" "x \<otimes> y = \<one>" "y \<otimes> x = \<one>"
  shows "inv x = y"
  using assms inv_unique' by auto

lemma (in comm_monoid) comm_inv_char: "x \<in> carrier G \<Longrightarrow> y \<in> carrier G \<Longrightarrow> x \<otimes> y = \<one> \<Longrightarrow> inv x = y"
  by (simp add: inv_char m_comm)

lemma (in ring) inv_neg_one [simp]: "inv (\<ominus> \<one>) = \<ominus> \<one>"
  by (simp add: inv_char local.ring_axioms ring.r_minus)

lemma (in monoid) inv_eq_imp_eq: "x \<in> Units G \<Longrightarrow> y \<in> Units G \<Longrightarrow> inv x = inv y \<Longrightarrow> x = y"
  by (metis Units_inv_inv)

lemma (in ring) Units_minus_one_closed [intro]: "\<ominus> \<one> \<in> Units R"
  by (simp add: Units_def) (metis add.l_inv_ex local.minus_minus minus_equality one_closed r_minus r_one)

lemma (in ring) inv_eq_neg_one_eq: "x \<in> Units R \<Longrightarrow> inv x = \<ominus> \<one> \<longleftrightarrow> x = \<ominus> \<one>"
  by (metis Units_inv_inv inv_neg_one)

lemma (in monoid) inv_eq_one_eq: "x \<in> Units G \<Longrightarrow> inv x = \<one> \<longleftrightarrow> x = \<one>"
  by (metis Units_inv_inv inv_one)

end


(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section \<open>Busemann functions\<close>

theory Busemann_Function
  imports Boundary_Extension Ergodic_Theory.Fekete
begin

text \<open>The Busemann function $B_\xi(x,y)$ measures the difference $d(\xi, x) - d(\xi, y)$, where $\xi$
is a point at infinity and $x$ and $y$ are inside a Gromov hyperbolic space. This is not well defined
in this way, as we are subtracting two infinities, but one can make sense of this difference by
considering the behavior along a sequence tending to $\xi$. The limit may depend on the sequence, but
as usual in Gromov hyperbolic spaces it only depends on the sequence up to a uniform constant. Thus,
we may define the Busemann function using for instance the supremum of the limsup over all possible
sequences -- other choices would give rise to equivalent definitions, up to some multiple of
$\delta$.\<close>

definition Busemann_function_at::"('a::Gromov_hyperbolic_space) Gromov_completion \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> real"
  where "Busemann_function_at xi x y = real_of_ereal (
    Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi})"

text \<open>Since limsups are only defined for complete orders currently, the definition goes through
ereals, and we go back to reals afterwards. However, there is no real difficulty here, as eveything
is bounded above and below (by $d(x,y)$ and $-d(x,y)$ respectively.\<close>

lemma Busemann_function_ereal:
  "ereal(Busemann_function_at xi x y) = Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
proof -
  have A: "Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi} \<le> dist x y"
    by (rule Sup_least, auto intro!: Limsup_bounded always_eventually mono_intros simp add: algebra_simps)
  have B: "Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi} \<ge> -dist x y"
  proof -
    obtain u where *: "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
      using rep_Gromov_completion_limit[of xi] by blast
    have "ereal(-dist x y) \<le> limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n)))"
      by (rule le_Limsup, auto intro!: always_eventually mono_intros simp add: algebra_simps)
    also have "... \<le> Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
      apply (rule Sup_upper) using * by auto
    finally show ?thesis by simp
  qed
  show ?thesis
    unfolding Busemann_function_at_def apply (rule ereal_real') using A B by auto
qed

text \<open>If $\xi$ is not at infinity, then the Busemann function is simply the difference of the
distances.\<close>

lemma Busemann_function_inner:
  "Busemann_function_at (to_Gromov_completion z) x y = dist x z - dist y z"
proof -
  have L: "limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) = dist x z - dist y z" if "u \<longlonglongrightarrow> z" for u
    by (rule lim_imp_Limsup, simp, intro tendsto_intros that)
  have "Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. u \<longlonglongrightarrow> z}
      = dist x z - dist y z"
  proof -
    obtain u where u: "u \<longlonglongrightarrow> z"
      by auto
    show ?thesis
      apply (rule order.antisym)
      apply (subst Sup_le_iff) using L apply auto[1]
      apply (subst L[OF u, symmetric]) apply (rule Sup_upper) using u by auto
  qed
  then have "ereal (Busemann_function_at (to_Gromov_completion z) x y) = dist x z - dist y z"
    unfolding Busemann_function_ereal by auto
  then show ?thesis by auto
qed

text \<open>The Busemann function measured at the same points vanishes.\<close>

lemma Busemann_function_xx [simp]:
  "Busemann_function_at xi x x = 0"
proof -
  have *: "{limsup (\<lambda>n. ereal(dist x (u n) - dist x (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi} = {0}"
    by (auto simp add: zero_ereal_def[symmetric] intro!: lim_imp_Limsup rep_Gromov_completion_limit[of xi])
  have "ereal (Busemann_function_at xi x x) = ereal 0"
    unfolding Busemann_function_ereal * by auto
  then show ?thesis
    by auto
qed

text \<open>Perturbing the points gives rise to a variation of the Busemann function bounded by the
size of the variations. This is obvious for inner Busemann functions, and everything passes
readily to the limit.\<close>

lemma Busemann_function_mono [mono_intros]:
  "Busemann_function_at xi x y \<le> Busemann_function_at xi x' y' + dist x x' + dist y y'"
proof -
  have A: "limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n)))
          \<le> ereal(Busemann_function_at xi x' y') + ereal (dist x x' + dist y y')"
    if "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi" for u
  proof -
    have *: "dist x z + dist y' z \<le> dist x x' + (dist y y' + (dist x' z + dist y z))" for z
      using add_mono[OF dist_triangle[of x z x'] dist_triangle[of y' z y]] dist_commute[of y y'] by auto
    have "limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
      = limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n)) + (- ereal (dist x x' + dist y y')))"
      by (rule Limsup_add_ereal_right[symmetric], auto)
    also have "... \<le> limsup (\<lambda>n. ereal (dist x' (u n) - dist y' (u n)))"
      by (auto intro!: Limsup_mono always_eventually simp: algebra_simps *)
    also have "... \<le> Sup {limsup (\<lambda>n. ereal (dist x' (u n) - dist y' (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
      apply (rule Sup_upper) using that by auto
    finally have "limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
          \<le> ereal(Busemann_function_at xi x' y')"
      unfolding Busemann_function_ereal by auto
    then show ?thesis
      unfolding minus_ereal_def[symmetric] by (subst ereal_minus_le[symmetric], auto)
  qed
  have "ereal (Busemann_function_at xi x y) \<le> ereal(Busemann_function_at xi x' y') + dist x x' + dist y y'"
    unfolding Busemann_function_ereal[of xi x y] using A by (auto intro!: Sup_least simp: algebra_simps)
  then show ?thesis by simp
qed

text \<open>In particular, it follows that the Busemann function $B_\xi(x,y)$ is bounded in absolute value
by $d(x,y)$.\<close>

lemma Busemann_function_le_dist [mono_intros]:
  "abs(Busemann_function_at xi x y) \<le> dist x y"
using Busemann_function_mono[of xi x y y y] Busemann_function_mono[of xi x x x y] by auto

lemma Busemann_function_Lipschitz [mono_intros]:
  "abs(Busemann_function_at xi x y - Busemann_function_at xi x' y') \<le> dist x x' + dist y y'"
using Busemann_function_mono[of xi x y x' y'] Busemann_function_mono[of xi x' y' x y] by (simp add: dist_commute)

text \<open>By the very definition of the Busemann function, the difference of distance functions is
bounded above by the Busemann function when one converges to $\xi$.\<close>

lemma Busemann_function_limsup:
  assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
  shows "limsup (\<lambda>n. dist x (u n) - dist y (u n)) \<le> Busemann_function_at xi x y"
unfolding Busemann_function_ereal apply (rule Sup_upper) using assms by auto

text \<open>There is also a corresponding bound below, but with the loss of a constant. This follows
from the hyperbolicity of the space and a simple computation.\<close>

lemma Busemann_function_liminf:
  assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
  shows "Busemann_function_at xi x y \<le> liminf (\<lambda>n. dist (x::'a::Gromov_hyperbolic_space) (u n) - dist y (u n)) + 2 * deltaG(TYPE('a))"
proof (cases xi)
  case (to_Gromov_completion z)
  have *: "liminf (\<lambda>n. dist x (u n) - dist y (u n)) = dist x z - dist y z"
    apply (rule lim_imp_Liminf, simp, intro tendsto_intros)
    using assms unfolding to_Gromov_completion by auto
  show ?thesis
    unfolding to_Gromov_completion plus_ereal.simps(1)[symmetric] Busemann_function_inner * by auto
next
  case boundary
  have I: "limsup (\<lambda>n. ereal(dist x (v n) - dist y (v n))) \<le> liminf (\<lambda>n. ereal(dist x (u n) - dist y (u n))) + 2 * deltaG(TYPE('a))"
    if v: "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> xi" for v
  proof -
    obtain N where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> Gromov_product_at x (u m) (v n) \<ge> dist x y"
      using same_limit_imp_Gromov_product_tendsto_infinity[OF boundary assms v] by blast
    have A: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a)) \<le> dist x (u m) - dist y (u m)" if "m \<ge> N" "n \<ge> N" for m n
    proof -
      have "Gromov_product_at x (v n) y \<le> dist x y"
        by (intro mono_intros)
      then have "min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) = Gromov_product_at x (v n) y"
        using N[OF \<open>m \<ge> N\<close> \<open>n \<ge> N\<close>] by linarith
      moreover have "Gromov_product_at x (u m) y \<ge> min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) - deltaG(TYPE('a))"
        by (intro mono_intros)
      ultimately have "Gromov_product_at x (u m) y \<ge> Gromov_product_at x (v n) y - deltaG(TYPE('a))"
        by auto
      then show ?thesis
        unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps dist_commute)
    qed
    have B: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a)) \<le> liminf (\<lambda>m. dist x (u m) - dist y (u m))" if "n \<ge> N" for n
      apply (rule Liminf_bounded) using A[OF _ that] unfolding eventually_sequentially by auto
    have C: "dist x (v n) - dist y (v n) \<le> liminf (\<lambda>m. dist x (u m) - dist y (u m)) + 2 * deltaG(TYPE('a))" if "n \<ge> N" for n
      using B[OF that] by (subst ereal_minus_le[symmetric], auto)
    show ?thesis
      apply (rule Limsup_bounded) unfolding eventually_sequentially apply (rule exI[of _ N]) using C by auto
  qed
  show ?thesis
    unfolding Busemann_function_ereal apply (rule Sup_least) using I by auto
qed

text \<open>To avoid formulating things in terms of liminf and limsup on ereal, the following formulation
of the two previous lemmas is useful.\<close>

lemma Busemann_function_inside_approx:
  assumes "e > (0::real)" "(\<lambda>n. to_Gromov_completion (t n::'a::Gromov_hyperbolic_space)) \<longlonglongrightarrow> xi"
  shows "eventually (\<lambda>n. Busemann_function_at (to_Gromov_completion (t n)) x y \<le> Busemann_function_at xi x y + e
              \<and> Busemann_function_at (to_Gromov_completion (t n)) x y \<ge> Busemann_function_at xi x y - 2 * deltaG(TYPE('a)) - e) sequentially"
proof -
  have A: "eventually (\<lambda>n. Busemann_function_at (to_Gromov_completion (t n)) x y < Busemann_function_at xi x y + ereal e) sequentially"
    apply (rule Limsup_lessD)
    unfolding Busemann_function_inner using le_less_trans[OF Busemann_function_limsup[OF assms(2)]] \<open>e > 0\<close> by auto
  have B: "eventually (\<lambda>n. Busemann_function_at (to_Gromov_completion (t n)) x y > Busemann_function_at xi x y -2 * deltaG(TYPE('a)) - ereal e) sequentially"
    apply (rule less_LiminfD)
    unfolding Busemann_function_inner using less_le_trans[OF _ Busemann_function_liminf[OF assms(2)], of "ereal(Busemann_function_at xi x y) - ereal e" x y] \<open>e > 0\<close> apply auto
    apply (unfold ereal_minus(1)[symmetric], subst ereal_minus_less_iff, simp)+
    unfolding ereal_minus(1)[symmetric] by (simp only: ereal_minus_less_iff, auto simp add: algebra_simps)
  show ?thesis
    by (rule eventually_mono[OF eventually_conj[OF A B]], auto)
qed

text \<open>The Busemann function is essentially a morphism, i.e., it should satisfy $B_\xi(x,z) =
B_\xi(x,y) + B_\xi(y,z)$, as it is defined as a difference of distances. This is not exactly
the case as there is a choice in the definition, but it is the case up to a uniform constant,
as we show in the next few lemmas. One says that it is a~\emph{quasi-morphism}.\<close>

lemma Busemann_function_triangle [mono_intros]:
  "Busemann_function_at xi x z \<le> Busemann_function_at xi x y + Busemann_function_at xi y z"
proof -
  have "limsup (\<lambda>n. dist x (u n) - dist z (u n)) \<le> Busemann_function_at xi x y + Busemann_function_at xi y z"
    if "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi" for u
  proof -
    have "limsup (\<lambda>n. dist x (u n) - dist z (u n)) = limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n)) + (dist y (u n) - dist z (u n)))"
      by auto
    also have "... \<le> limsup (\<lambda>n. dist x (u n) - dist y (u n)) + limsup (\<lambda>n. dist y (u n) - dist z (u n))"
      by (rule ereal_limsup_add_mono)
    also have "... \<le> ereal(Busemann_function_at xi x y) + Busemann_function_at xi y z"
      unfolding Busemann_function_ereal using that by (auto intro!: add_mono Sup_upper)
    finally show ?thesis by auto
  qed
  then have "ereal (Busemann_function_at xi x z) \<le> Busemann_function_at xi x y + Busemann_function_at xi y z"
    unfolding Busemann_function_ereal[of xi x z] by (auto intro!: Sup_least)
  then show ?thesis
    by auto
qed

lemma Busemann_function_xy_yx [mono_intros]:
  "Busemann_function_at xi x y + Busemann_function_at xi y (x::'a::Gromov_hyperbolic_space) \<le> 2 * deltaG(TYPE('a))"
proof -
  have *: "- liminf (\<lambda>n. ereal (dist y (u n) - dist x (u n))) \<le> ereal (2 * deltaG TYPE('a) - Busemann_function_at xi y x)"
    if "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi" for u
    using Busemann_function_liminf[of _ xi y x, OF that] ereal_minus_le_minus_plus unfolding ereal_minus(1)[symmetric]
    by fastforce

  have "ereal (Busemann_function_at xi x y) = Sup {limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
    unfolding Busemann_function_ereal by auto
  also have "... = Sup {limsup (\<lambda>n. - ereal(dist y (u n) - dist x (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
    by auto
  also have "... = Sup {- liminf (\<lambda>n. ereal(dist y (u n) - dist x (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}"
    unfolding ereal_Limsup_uminus by auto
  also have "... \<le> 2 * deltaG(TYPE('a)) - ereal(Busemann_function_at xi y x)"
    by (auto intro!: Sup_least *)
  finally show ?thesis
    by simp
qed

theorem Busemann_function_quasi_morphism [mono_intros]:
  "\<bar>Busemann_function_at xi x y + Busemann_function_at xi y z - Busemann_function_at xi x (z::'a::Gromov_hyperbolic_space)\<bar> \<le> 2 * deltaG(TYPE('a))"
using Busemann_function_triangle[of xi x z y] Busemann_function_triangle[of xi x y z] Busemann_function_xy_yx[of xi y z] by auto

text \<open>The extended Gromov product can be bounded from below by the Busemann function.\<close>

lemma Busemann_function_le_Gromov_product:
  "- Busemann_function_at xi y x/2 \<le> extended_Gromov_product_at x xi (to_Gromov_completion y)"
proof -
  have A: "-ereal(Busemann_function_at xi y x/2) \<le> liminf (\<lambda>n. Gromov_product_at x (u n) y)"
    if "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi" for u
  proof -
    have *: "limsup (\<lambda>n. - ereal (Gromov_product_at x (u n) y) * 2) \<le> limsup (\<lambda>n. ereal (dist y (u n) - dist x (u n)))"
      by (auto intro!: Limsup_mono always_eventually simp: algebra_simps Gromov_product_at_def divide_simps dist_commute)
    also have "... \<le> ereal(Busemann_function_at xi y x)"
      unfolding Busemann_function_ereal using that by (auto intro!: Sup_upper)
    finally have "-ereal(Busemann_function_at xi y x) \<le> liminf (\<lambda>n. Gromov_product_at x (u n) y) * ereal 2"
      apply (subst ereal_uminus_le_reorder, subst ereal_mult_minus_left[symmetric], subst ereal_Limsup_uminus[symmetric])
      by (subst limsup_ereal_mult_right[symmetric], auto)
    moreover have "-ereal(z/2) \<le> t" if "-ereal z \<le> t * ereal 2" for z t
    proof -
      have *: "-ereal(z/2) = -ereal z / ereal 2"
        unfolding ereal_divide by auto
      have "0 < ereal 2"
        by auto
      then show ?thesis unfolding * using that
        by (metis (no_types) PInfty_neq_ereal(2) ereal_divide_le_posI ereal_uminus_eq_iff mult.commute that)
    qed
    ultimately show ?thesis by auto
  qed
  show ?thesis
  unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
    fix u v assume uv: "xi = abs_Gromov_completion u" "abs_Gromov_completion v = to_Gromov_completion y" "Gromov_completion_rel u u" "Gromov_completion_rel v v"
    then have L: "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
      using abs_Gromov_completion_limit by auto
    have *: "v n = y" for n
      using uv by (metis (mono_tags, hide_lams) Gromov_completion_rel_def Quotient3_Gromov_completion Quotient3_rep_abs abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion)
    show "ereal (- (Busemann_function_at (abs_Gromov_completion u) y x / 2)) \<le> liminf (\<lambda>n. ereal (Gromov_product_at x (u n) (v n)))"
      unfolding uv(1)[symmetric] * using A[OF L] by simp
  qed
qed

text \<open>It follows that, if the Busemann function tends to minus infinity, i.e., the distance to
$\xi$ becomes smaller and smaller in a suitable sense, then the sequence is converging to $\xi$.
This is only an implication: one can have sequences tending to $\xi$ for which the Busemann function
does not tend to $-\infty$. This is in fact a stronger notion of convergence, sometimes called
radial convergence.\<close>

proposition Busemann_function_minus_infinity_imp_convergent:
  assumes "((\<lambda>n. Busemann_function_at xi (u n) x) \<longlongrightarrow> -\<infinity>) F"
  shows "((\<lambda>n. to_Gromov_completion (u n)) \<longlongrightarrow> xi) F"
proof (cases "trivial_limit F")
  case True
  then show ?thesis by auto
next
  case False
  have "xi \<in> Gromov_boundary"
  proof (cases xi)
    case (to_Gromov_completion z)
    then have "ereal(Busemann_function_at xi (u n) x) \<ge> - dist x z" for n
      unfolding to_Gromov_completion Busemann_function_inner by auto
    then have "-\<infinity> \<ge> -dist x z"
      using tendsto_lowerbound[OF assms always_eventually False] by metis
    then have False
      by auto
    then show ?thesis by auto
  qed
  have "((\<lambda>n. - ereal (Busemann_function_at xi (u n) x) / 2) \<longlongrightarrow> (- (-\<infinity>)/2)) F"
    apply (intro tendsto_intros) using assms by auto
  then have *: "((\<lambda>n. - ereal (Busemann_function_at xi (u n) x) / 2) \<longlongrightarrow> \<infinity>) F"
    by auto
  have **: "((\<lambda>n. extended_Gromov_product_at x xi (to_Gromov_completion (u n))) \<longlongrightarrow> \<infinity>) F"
    apply (rule tendsto_sandwich[of "\<lambda>n. - ereal (Busemann_function_at xi (u n) x) / 2" _ _ "\<lambda>n. \<infinity>", OF always_eventually always_eventually])
    using Busemann_function_le_Gromov_product[of xi _ x] * by auto
  show ?thesis
    using extended_Gromov_product_tendsto_PInf_a_b[OF **, of basepoint]
    by (auto simp add: Gromov_completion_boundary_limit[OF \<open>xi \<in> Gromov_boundary\<close>] extended_Gromov_product_at_commute)
qed

text \<open>Busemann functions are invariant under isometries. This is trivial as everything is defined
in terms of the distance, but the definition in terms of supremum and limsups makes the proof
tedious.\<close>

lemma Busemann_function_isometry:
  assumes "isometry f"
  shows "Busemann_function_at (Gromov_extension f xi) (f x) (f y) = Busemann_function_at xi x y"
proof -
  have "{limsup (\<lambda>n. ereal(dist x (u n) - dist y (u n))) |u. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi}
        = {limsup (\<lambda>n. ereal(dist (f x) (v n) - dist (f y) (v n))) |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> Gromov_extension f xi}"
  proof (auto)
    fix u assume u: "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
    define v where "v = f o u"
    have "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> Gromov_extension f xi"
      unfolding v_def comp_def Gromov_extension_inside_space[symmetric] using u Gromov_extension_isometry(2)[OF \<open>isometry f\<close>]
      by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
    moreover have "limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n))) = limsup (\<lambda>n. ereal (dist (f x) (v n) - dist (f y) (v n)))"
      unfolding v_def comp_def isometryD(2)[OF \<open>isometry f\<close>] by simp
    ultimately show "\<exists>v. limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n))) = limsup (\<lambda>n. ereal (dist (f x) (v n) - dist (f y) (v n))) \<and>
              (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> Gromov_extension f xi"
      by blast
  next
    fix v assume v: "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> Gromov_extension f xi"
    define u where "u = (inv f) o v"
    have "isometry (inv f)"
      using isometry_inverse(1)[OF \<open>isometry f\<close>] by simp
    have *: "inv f (f z) = z" for z
      using isometry_inverse(2)[OF \<open>isometry f\<close>] by (simp add: bij_betw_def)
    have **: "(Gromov_extension (inv f) (Gromov_extension f xi)) = xi"
      using Gromov_extension_isometry_composition[OF \<open>isometry f\<close> \<open>isometry (inv f)\<close>]
      unfolding comp_def using isometry_inverse(2)[OF \<open>isometry f\<close>] by (auto simp: *, metis)
    have "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> Gromov_extension (inv f) (Gromov_extension f xi)"
      unfolding u_def comp_def Gromov_extension_inside_space[symmetric] using v Gromov_extension_isometry(2)[OF \<open>isometry (inv f)\<close>]
      by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
    then have "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
      using ** by auto
    moreover have "limsup (\<lambda>n. ereal (dist ((inv f) (f x)) (u n) - dist ((inv f) (f y)) (u n))) = limsup (\<lambda>n. ereal (dist (f x) (v n) - dist (f y) (v n)))"
      unfolding u_def comp_def isometryD(2)[OF \<open>isometry (inv f)\<close>] by simp
    ultimately show "\<exists>u. limsup (\<lambda>n. ereal (dist (f x) (v n) - dist (f y) (v n))) = limsup (\<lambda>n. ereal (dist x (u n) - dist y (u n))) \<and> (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
      by (simp add: *, force)
  qed
  then have "ereal (Busemann_function_at xi x y) = ereal (Busemann_function_at (Gromov_extension f xi) (f x) (f y))"
    unfolding Busemann_function_ereal by auto
  then show ?thesis by auto
qed

lemma dist_minus_Busemann_max_ineq:
  "dist (x::'a::Gromov_hyperbolic_space) z - Busemann_function_at xi z x \<le> max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a))"
proof -
  have I: "dist x z - Busemann_function_at (to_Gromov_completion t) z x \<le> max (dist x y - Busemann_function_at (to_Gromov_completion t) y x)
                      (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
                        + 2 * deltaG(TYPE('a))" for t
  proof -
    have "2 * dist x t + - max (dist x y - Busemann_function_at (to_Gromov_completion t) y x) (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
          = min (2 * dist x t - (dist x y - Busemann_function_at (to_Gromov_completion t) y x)) (2 * dist x t - (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x))"
      unfolding minus_max_eq_min min_add_distrib_right by auto
    also have "... = min (2 * Gromov_product_at t x y) (2 * Gromov_product_at t y z)"
      apply (rule cong[of "min _" "min _"], rule cong [of min min])
      unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
    also have "... = 2 * (min (Gromov_product_at t x y) (Gromov_product_at t y z))"
      by auto
    also have "... \<le> 2 * (Gromov_product_at t x z + deltaG(TYPE('a)))"
      by (intro mono_intros, auto)
    also have "... = 2 * dist x t - (dist x z - Busemann_function_at (to_Gromov_completion t) z x) + 2 * deltaG(TYPE('a))"
      unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
    finally show ?thesis
      by auto
  qed
  have "dist x z - Busemann_function_at xi z x \<le> max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + d"
    if "d > 0" for d
  proof -
    define e where "e = d/4"
    have "e > 0" unfolding e_def using that by auto
    obtain t where t: "(\<lambda>n. to_Gromov_completion (t n)) \<longlonglongrightarrow> xi"
      using rep_Gromov_completion_limit by auto
    have A: "eventually (\<lambda>n. Busemann_function_at xi y x \<le> Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF \<open>e > 0\<close> t, of y x]], auto)
    have B: "eventually (\<lambda>n. Busemann_function_at xi z y \<le> Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF \<open>e > 0\<close> t, of z y]], auto)
    have C: "eventually (\<lambda>n. Busemann_function_at xi z x \<ge> Busemann_function_at (to_Gromov_completion (t n)) z x - e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF \<open>e > 0\<close> t, of z x]], auto)
    obtain n where H: "Busemann_function_at xi y x \<le> Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e"
                      "Busemann_function_at xi z y \<le> Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e"
                      "Busemann_function_at xi z x \<ge> Busemann_function_at (to_Gromov_completion (t n)) z x - e"
      using eventually_conj[OF A eventually_conj[OF B C]] eventually_sequentially by auto
    have "dist x z - Busemann_function_at xi z x - e \<le> dist x z - Busemann_function_at (to_Gromov_completion (t n)) z x"
      using H by auto
    also have "... \<le> max (dist x y - Busemann_function_at (to_Gromov_completion (t n)) y x)
                      (dist y z - Busemann_function_at (to_Gromov_completion (t n)) z y - 2 * Busemann_function_at (to_Gromov_completion (t n)) y x)
                        + 2 * deltaG(TYPE('a))"
      using I by auto
    also have "... \<le> max (dist x y - (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
                      (dist y z - (Busemann_function_at xi z y - 2 * deltaG(TYPE('a)) - e) - 2 * (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
                        + 2 * deltaG(TYPE('a))"
      apply (intro mono_intros) using H by auto
    also have "... \<le> max (dist x y - Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
                      (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
                        + 2 * deltaG(TYPE('a))"
      apply (intro add_mono max.mono) using \<open>e > 0\<close> by auto
    also have "... = max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + 3 * e"
      by auto
    finally show ?thesis unfolding e_def by auto
  qed
  then show ?thesis by (rule field_le_epsilon)
qed

end (*of theory Busemann_Function*)