(*  Title:      HOL/Analysis/Lipschitz.thy
    Author:     Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    Author:     Fabian Immler, TU München
*)
section \<open>Lipschitz Continuity\<close>

theory Lipschitz
  imports
    Derivative
begin

definition\<^marker>\<open>tag important\<close> lipschitz_on
  where "lipschitz_on C U f \<longleftrightarrow> (0 \<le> C \<and> (\<forall>x \<in> U. \<forall>y\<in>U. dist (f x) (f y) \<le> C * dist x y))"

bundle lipschitz_syntax begin
notation\<^marker>\<open>tag important\<close> lipschitz_on ("_-lipschitz'_on" [1000])
end
bundle no_lipschitz_syntax begin
no_notation lipschitz_on ("_-lipschitz'_on" [1000])
end

unbundle lipschitz_syntax

lemma lipschitz_onI: "L-lipschitz_on X f"
  if "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> dist (f x) (f y) \<le> L * dist x y" "0 \<le> L"
  using that by (auto simp: lipschitz_on_def)

lemma lipschitz_onD:
  "dist (f x) (f y) \<le> L * dist x y"
  if "L-lipschitz_on X f" "x \<in> X" "y \<in> X"
  using that by (auto simp: lipschitz_on_def)

lemma lipschitz_on_nonneg:
  "0 \<le> L" if "L-lipschitz_on X f"
  using that by (auto simp: lipschitz_on_def)

lemma lipschitz_on_normD:
  "norm (f x - f y) \<le> L * norm (x - y)"
  if "lipschitz_on L X f" "x \<in> X" "y \<in> X"
  using lipschitz_onD[OF that]
  by (simp add: dist_norm)

lemma lipschitz_on_mono: "L-lipschitz_on D f" if "M-lipschitz_on E f" "D \<subseteq> E" "M \<le> L"
  using that
  by (force simp: lipschitz_on_def intro: order_trans[OF _ mult_right_mono])

lemmas lipschitz_on_subset = lipschitz_on_mono[OF _ _ order_refl]
  and lipschitz_on_le = lipschitz_on_mono[OF _ order_refl]

lemma lipschitz_on_leI:
  "L-lipschitz_on X f"
  if "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> x \<le> y \<Longrightarrow> dist (f x) (f y) \<le> L * dist x y"
    "0 \<le> L"
  for f::"'a::{linorder_topology, ordered_real_vector, metric_space} \<Rightarrow> 'b::metric_space"
proof (rule lipschitz_onI)
  fix x y assume xy: "x \<in> X" "y \<in> X"
  consider "y \<le> x" | "x \<le> y"
    by (rule le_cases)
  then show "dist (f x) (f y) \<le> L * dist x y"
  proof cases
    case 1
    then have "dist (f y) (f x) \<le> L * dist y x"
      by (auto intro!: that xy)
    then show ?thesis
      by (simp add: dist_commute)
  qed (auto intro!: that xy)
qed fact

lemma lipschitz_on_concat:
  fixes a b c::real
  assumes f: "L-lipschitz_on {a .. b} f"
  assumes g: "L-lipschitz_on {b .. c} g"
  assumes fg: "f b = g b"
  shows "lipschitz_on L {a .. c} (\<lambda>x. if x \<le> b then f x else g x)"
    (is "lipschitz_on _ _ ?f")
proof (rule lipschitz_on_leI)
  fix x y
  assume x: "x \<in> {a..c}" and y: "y \<in> {a..c}" and xy: "x \<le> y"
  consider "x \<le> b \<and> b < y" | "x \<ge> b \<or> y \<le> b" by arith
  then show "dist (?f x) (?f y) \<le> L * dist x y"
  proof cases
    case 1
    have "dist (f x) (g y) \<le> dist (f x) (f b) + dist (g b) (g y)"
      unfolding fg by (rule dist_triangle)
    also have "dist (f x) (f b) \<le> L * dist x b"
      using 1 x
      by (auto intro!: lipschitz_onD[OF f])
    also have "dist (g b) (g y) \<le> L * dist b y"
      using 1 x y
      by (auto intro!: lipschitz_onD[OF g] lipschitz_onD[OF f])
    finally have "dist (f x) (g y) \<le> L * dist x b + L * dist b y"
      by simp
    also have "\<dots> = L * (dist x b + dist b y)"
      by (simp add: algebra_simps)
    also have "dist x b + dist b y = dist x y"
      using 1 x y
      by (auto simp: dist_real_def abs_real_def)
    finally show ?thesis
      using 1 by simp
  next
    case 2
    with lipschitz_onD[OF f, of x y] lipschitz_onD[OF g, of x y] x y xy
    show ?thesis
      by (auto simp: fg)
  qed
qed (rule lipschitz_on_nonneg[OF f])

lemma lipschitz_on_concat_max:
  fixes a b c::real
  assumes f: "L-lipschitz_on {a .. b} f"
  assumes g: "M-lipschitz_on {b .. c} g"
  assumes fg: "f b = g b"
  shows "(max L M)-lipschitz_on {a .. c} (\<lambda>x. if x \<le> b then f x else g x)"
proof -
  have "lipschitz_on (max L M) {a .. b} f" "lipschitz_on (max L M) {b .. c} g"
    by (auto intro!: lipschitz_on_mono[OF f order_refl] lipschitz_on_mono[OF g order_refl])
  from lipschitz_on_concat[OF this fg] show ?thesis .
qed

subsubsection \<open>Continuity\<close>

proposition lipschitz_on_uniformly_continuous:
  assumes "L-lipschitz_on X f"
  shows "uniformly_continuous_on X f"
  unfolding uniformly_continuous_on_def
proof safe
  fix e::real
  assume "0 < e"
  from assms have l: "(L+1)-lipschitz_on X f"
    by (rule lipschitz_on_mono) auto
  show "\<exists>d>0. \<forall>x\<in>X. \<forall>x'\<in>X. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
    using lipschitz_onD[OF l] lipschitz_on_nonneg[OF assms] \<open>0 < e\<close>
    by (force intro!: exI[where x="e/(L + 1)"] simp: field_simps)
qed

proposition lipschitz_on_continuous_on:
  "continuous_on X f" if "L-lipschitz_on X f"
  by (rule uniformly_continuous_imp_continuous[OF lipschitz_on_uniformly_continuous[OF that]])

lemma lipschitz_on_continuous_within:
  "continuous (at x within X) f" if "L-lipschitz_on X f" "x \<in> X"
  using lipschitz_on_continuous_on[OF that(1)] that(2)
  by (auto simp: continuous_on_eq_continuous_within)

subsubsection \<open>Differentiable functions\<close>

proposition bounded_derivative_imp_lipschitz:
  assumes "\<And>x. x \<in> X \<Longrightarrow> (f has_derivative f' x) (at x within X)"
  assumes convex: "convex X"
  assumes "\<And>x. x \<in> X \<Longrightarrow> onorm (f' x) \<le> C" "0 \<le> C"
  shows "C-lipschitz_on X f"
proof (rule lipschitz_onI)
  show "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> dist (f x) (f y) \<le> C * dist x y"
    by (auto intro!: assms differentiable_bound[unfolded dist_norm[symmetric], OF convex])
qed fact

subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Structural introduction rules\<close>

named_theorems lipschitz_intros "structural introduction rules for Lipschitz controls"

lemma lipschitz_on_compose [lipschitz_intros]:
  "(D * C)-lipschitz_on U (g o f)"
  if f: "C-lipschitz_on U f" and g: "D-lipschitz_on (f`U) g"
proof (rule lipschitz_onI)
  show "D* C \<ge> 0" using lipschitz_on_nonneg[OF f] lipschitz_on_nonneg[OF g] by auto
  fix x y assume H: "x \<in> U" "y \<in> U"
  have "dist (g (f x)) (g (f y)) \<le> D * dist (f x) (f y)"
    apply (rule lipschitz_onD[OF g]) using H by auto
  also have "... \<le> D * C * dist x y"
    using mult_left_mono[OF lipschitz_onD(1)[OF f H] lipschitz_on_nonneg[OF g]] by auto
  finally show "dist ((g \<circ> f) x) ((g \<circ> f) y) \<le> D * C* dist x y"
    unfolding comp_def by (auto simp add: mult.commute)
qed

lemma lipschitz_on_compose2:
  "(D * C)-lipschitz_on U (\<lambda>x. g (f x))"
  if "C-lipschitz_on U f" "D-lipschitz_on (f`U) g"
  using lipschitz_on_compose[OF that] by (simp add: o_def)

lemma lipschitz_on_cong[cong]:
  "C-lipschitz_on U g \<longleftrightarrow> D-lipschitz_on V f"
  if "C = D" "U = V" "\<And>x. x \<in> V \<Longrightarrow> g x = f x"
  using that by (auto simp: lipschitz_on_def)

lemma lipschitz_on_transform:
  "C-lipschitz_on U g"
  if "C-lipschitz_on U f"
    "\<And>x. x \<in> U \<Longrightarrow> g x = f x"
  using that
  by simp

lemma lipschitz_on_empty_iff[simp]: "C-lipschitz_on {} f \<longleftrightarrow> C \<ge> 0"
  by (auto simp: lipschitz_on_def)

lemma lipschitz_on_insert_iff[simp]:
  "C-lipschitz_on (insert y X) f \<longleftrightarrow>
    C-lipschitz_on X f \<and> (\<forall>x \<in> X. dist (f x) (f y) \<le> C * dist x y)"
  by (auto simp: lipschitz_on_def dist_commute)

lemma lipschitz_on_singleton [lipschitz_intros]: "C \<ge> 0 \<Longrightarrow> C-lipschitz_on {x} f"
  and lipschitz_on_empty [lipschitz_intros]: "C \<ge> 0 \<Longrightarrow> C-lipschitz_on {} f"
  by simp_all

lemma lipschitz_on_id [lipschitz_intros]: "1-lipschitz_on U (\<lambda>x. x)"
  by (auto simp: lipschitz_on_def)

lemma lipschitz_on_constant [lipschitz_intros]: "0-lipschitz_on U (\<lambda>x. c)"
  by (auto simp: lipschitz_on_def)

lemma lipschitz_on_add [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
  assumes "C-lipschitz_on U f"
    "D-lipschitz_on U g"
  shows "(C+D)-lipschitz_on U (\<lambda>x. f x + g x)"
proof (rule lipschitz_onI)
  show "C + D \<ge> 0"
    using lipschitz_on_nonneg[OF assms(1)] lipschitz_on_nonneg[OF assms(2)] by auto
  fix x y assume H: "x \<in> U" "y \<in> U"
  have "dist (f x + g x) (f y + g y) \<le> dist (f x) (f y) + dist (g x) (g y)"
    by (simp add: dist_triangle_add)
  also have "... \<le> C * dist x y + D * dist x y"
    using lipschitz_onD(1)[OF assms(1) H] lipschitz_onD(1)[OF assms(2) H] by auto
  finally show "dist (f x + g x) (f y + g y) \<le> (C+D) * dist x y" by (auto simp add: algebra_simps)
qed

lemma lipschitz_on_cmult [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
  assumes "C-lipschitz_on U f"
  shows "(abs(a) * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
proof (rule lipschitz_onI)
  show "abs(a) * C \<ge> 0" using lipschitz_on_nonneg[OF assms(1)] by auto
  fix x y assume H: "x \<in> U" "y \<in> U"
  have "dist (a *\<^sub>R f x) (a *\<^sub>R f y) = abs(a) * dist (f x) (f y)"
    by (metis dist_norm norm_scaleR real_vector.scale_right_diff_distrib)
  also have "... \<le> abs(a) * C * dist x y"
    using lipschitz_onD(1)[OF assms(1) H] by (simp add: Groups.mult_ac(1) mult_left_mono)
  finally show "dist (a *\<^sub>R f x) (a *\<^sub>R f y) \<le> \<bar>a\<bar> * C * dist x y" by auto
qed

lemma lipschitz_on_cmult_real [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> real"
  assumes "C-lipschitz_on U f"
  shows "(abs(a) * C)-lipschitz_on U (\<lambda>x. a * f x)"
  using lipschitz_on_cmult[OF assms] by auto

lemma lipschitz_on_cmult_nonneg [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
  assumes "C-lipschitz_on U f"
    "a \<ge> 0"
  shows "(a * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
  using lipschitz_on_cmult[OF assms(1), of a] assms(2) by auto

lemma lipschitz_on_cmult_real_nonneg [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> real"
  assumes "C-lipschitz_on U f"
    "a \<ge> 0"
  shows "(a * C)-lipschitz_on U (\<lambda>x. a * f x)"
  using lipschitz_on_cmult_nonneg[OF assms] by auto

lemma lipschitz_on_cmult_upper [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
  assumes "C-lipschitz_on U f"
    "abs(a) \<le> D"
  shows "(D * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
  apply (rule lipschitz_on_mono[OF lipschitz_on_cmult[OF assms(1), of a], of _ "D * C"])
  using assms(2) lipschitz_on_nonneg[OF assms(1)] mult_right_mono by auto

lemma lipschitz_on_cmult_real_upper [lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow> real"
  assumes "C-lipschitz_on U f"
    "abs(a) \<le> D"
  shows "(D * C)-lipschitz_on U (\<lambda>x. a * f x)"
  using lipschitz_on_cmult_upper[OF assms] by auto

lemma lipschitz_on_minus[lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
  assumes "C-lipschitz_on U f"
  shows "C-lipschitz_on U (\<lambda>x. - f x)"
  by (metis (mono_tags, lifting) assms dist_minus lipschitz_on_def)

lemma lipschitz_on_minus_iff[simp]:
  "L-lipschitz_on X (\<lambda>x. - f x) \<longleftrightarrow> L-lipschitz_on X f"
  "L-lipschitz_on X (- f) \<longleftrightarrow> L-lipschitz_on X f"
  for f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
  using lipschitz_on_minus[of L X f] lipschitz_on_minus[of L X "-f"]
  by auto

lemma lipschitz_on_diff[lipschitz_intros]:
  fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
  assumes "C-lipschitz_on U f" "D-lipschitz_on U g"
  shows "(C + D)-lipschitz_on U (\<lambda>x. f x - g x)"
  using lipschitz_on_add[OF assms(1) lipschitz_on_minus[OF assms(2)]] by auto

lemma lipschitz_on_closure [lipschitz_intros]:
  assumes "C-lipschitz_on U f" "continuous_on (closure U) f"
  shows "C-lipschitz_on (closure U) f"
proof (rule lipschitz_onI)
  show "C \<ge> 0" using lipschitz_on_nonneg[OF assms(1)] by simp
  fix x y assume "x \<in> closure U" "y \<in> closure U"
  obtain u v::"nat \<Rightarrow> 'a" where *: "\<And>n. u n \<in> U" "u \<longlonglongrightarrow> x"
                                   "\<And>n. v n \<in> U" "v \<longlonglongrightarrow> y"
    using \<open>x \<in> closure U\<close> \<open>y \<in> closure U\<close> unfolding closure_sequential by blast
  have a: "(\<lambda>n. f (u n)) \<longlonglongrightarrow> f x"
    using *(1) *(2) \<open>x \<in> closure U\<close> \<open>continuous_on (closure U) f\<close>
    unfolding comp_def continuous_on_closure_sequentially[of U f] by auto
  have b: "(\<lambda>n. f (v n)) \<longlonglongrightarrow> f y"
    using *(3) *(4) \<open>y \<in> closure U\<close> \<open>continuous_on (closure U) f\<close>
    unfolding comp_def continuous_on_closure_sequentially[of U f] by auto
  have l: "(\<lambda>n. C * dist (u n) (v n) - dist (f (u n)) (f (v n))) \<longlonglongrightarrow> C * dist x y - dist (f x) (f y)"
    by (intro tendsto_intros * a b)
  have "C * dist (u n) (v n) - dist (f (u n)) (f (v n)) \<ge> 0" for n
    using lipschitz_onD(1)[OF assms(1) \<open>u n \<in> U\<close> \<open>v n \<in> U\<close>] by simp
  then have "C * dist x y - dist (f x) (f y) \<ge> 0" using LIMSEQ_le_const[OF l, of 0] by auto
  then show "dist (f x) (f y) \<le> C * dist x y" by auto
qed

lemma lipschitz_on_Pair[lipschitz_intros]:
  assumes f: "L-lipschitz_on A f"
  assumes g: "M-lipschitz_on A g"
  shows "(sqrt (L\<^sup>2 + M\<^sup>2))-lipschitz_on A (\<lambda>a. (f a, g a))"
proof (rule lipschitz_onI, goal_cases)
  case (1 x y)
  have "dist (f x, g x) (f y, g y) = sqrt ((dist (f x) (f y))\<^sup>2 + (dist (g x) (g y))\<^sup>2)"
    by (auto simp add: dist_Pair_Pair real_le_lsqrt)
  also have "\<dots> \<le> sqrt ((L * dist x y)\<^sup>2 + (M * dist x y)\<^sup>2)"
    by (auto intro!: real_sqrt_le_mono add_mono power_mono 1 lipschitz_onD f g)
  also have "\<dots> \<le> sqrt (L\<^sup>2 + M\<^sup>2) * dist x y"
    by (auto simp: power_mult_distrib ring_distribs[symmetric] real_sqrt_mult)
  finally show ?case .
qed simp

lemma lipschitz_extend_closure:
  fixes f::"('a::metric_space) \<Rightarrow> ('b::complete_space)"
  assumes "C-lipschitz_on U f"
  shows "\<exists>g. C-lipschitz_on (closure U) g \<and> (\<forall>x\<in>U. g x = f x)"
proof -
  obtain g where g: "\<And>x. x \<in> U \<Longrightarrow> g x = f x" "uniformly_continuous_on (closure U) g"
    using uniformly_continuous_on_extension_on_closure[OF lipschitz_on_uniformly_continuous[OF assms]] by metis
  have "C-lipschitz_on (closure U) g"
    apply (rule lipschitz_on_closure, rule lipschitz_on_transform[OF assms])
    using g uniformly_continuous_imp_continuous[OF g(2)] by auto
  then show ?thesis using g(1) by auto
qed

lemma (in bounded_linear) lipschitz_boundE:
  obtains B where "B-lipschitz_on A f"
proof -
  from nonneg_bounded
  obtain B where B: "B \<ge> 0" "\<And>x. norm (f x) \<le> B * norm x"
    by (auto simp: ac_simps)
  have "B-lipschitz_on A f"
    by (auto intro!: lipschitz_onI B simp: dist_norm diff[symmetric])
  thus ?thesis ..
qed

subsection \<open>Local Lipschitz continuity\<close>

text \<open>Given a function defined on a real interval, it is Lipschitz-continuous if and only if
it is locally so, as proved in the following lemmas. It is useful especially for
piecewise-defined functions: if each piece is Lipschitz, then so is the whole function.
The same goes for functions defined on geodesic spaces, or more generally on geodesic subsets
in a metric space (for instance convex subsets in a real vector space), and this follows readily
from the real case, but we will not prove it explicitly.

We give several variations around this statement. This is essentially a connectedness argument.\<close>

lemma locally_lipschitz_imp_lipschitz_aux:
  fixes f::"real \<Rightarrow> ('a::metric_space)"
  assumes "a \<le> b"
          "continuous_on {a..b} f"
          "\<And>x. x \<in> {a..<b} \<Longrightarrow> \<exists>y \<in> {x<..b}. dist (f y) (f x) \<le> M * (y-x)"
  shows "dist (f b) (f a) \<le> M * (b-a)"
proof -
  define A where "A = {x \<in> {a..b}. dist (f x) (f a) \<le> M * (x-a)}"
  have *: "A = (\<lambda>x. M * (x-a) - dist (f x) (f a))-`{0..} \<inter> {a..b}"
    unfolding A_def by auto
  have "a \<in> A" unfolding A_def using \<open>a \<le> b\<close> by auto
  then have "A \<noteq> {}" by auto
  moreover have "bdd_above A" unfolding A_def by auto
  moreover have "closed A" unfolding * by (rule closed_vimage_Int, auto intro!: continuous_intros assms)
  ultimately have "Sup A \<in> A" by (rule closed_contains_Sup)
  have "Sup A = b"
  proof (rule ccontr)
    assume "Sup A \<noteq> b"
    define x where "x = Sup A"
    have I: "dist (f x) (f a) \<le> M * (x-a)" using \<open>Sup A \<in> A\<close> x_def A_def by auto
    have "x \<in> {a..<b}" unfolding x_def using \<open>Sup A \<in> A\<close> \<open>Sup A \<noteq> b\<close> A_def by auto
    then obtain y where J: "y \<in> {x<..b}" "dist (f y) (f x) \<le> M * (y-x)" using assms(3) by blast
    have "dist (f y) (f a) \<le> dist (f y) (f x) + dist (f x) (f a)" by (rule dist_triangle)
    also have "... \<le> M * (y-x) + M * (x-a)" using I J(2) by auto
    finally have "dist (f y) (f a) \<le> M * (y-a)" by (auto simp add: algebra_simps)
    then have "y \<in> A" unfolding A_def using \<open>y \<in> {x<..b}\<close> \<open>x \<in> {a..<b}\<close> by auto
    then have "y \<le> Sup A" by (rule cSup_upper, auto simp: A_def)
    then show False using \<open>y \<in> {x<..b}\<close> x_def by auto
  qed
  then show ?thesis using \<open>Sup A \<in> A\<close> A_def by auto
qed

lemma locally_lipschitz_imp_lipschitz:
  fixes f::"real \<Rightarrow> ('a::metric_space)"
  assumes "continuous_on {a..b} f"
          "\<And>x y. x \<in> {a..<b} \<Longrightarrow> y > x \<Longrightarrow> \<exists>z \<in> {x<..y}. dist (f z) (f x) \<le> M * (z-x)"
          "M \<ge> 0"
  shows "lipschitz_on M {a..b} f"
proof (rule lipschitz_onI[OF _ \<open>M \<ge> 0\<close>])
  have *: "dist (f t) (f s) \<le> M * (t-s)" if "s \<le> t" "s \<in> {a..b}" "t \<in> {a..b}" for s t
  proof (rule locally_lipschitz_imp_lipschitz_aux, simp add: \<open>s \<le> t\<close>)
    show "continuous_on {s..t} f" using continuous_on_subset[OF assms(1)] that by auto
    fix x assume "x \<in> {s..<t}"
    then have "x \<in> {a..<b}" using that by auto
    show "\<exists>z\<in>{x<..t}. dist (f z) (f x) \<le> M * (z - x)"
      using assms(2)[OF \<open>x \<in> {a..<b}\<close>, of t] \<open>x \<in> {s..<t}\<close> by auto
  qed
  fix x y assume "x \<in> {a..b}" "y \<in> {a..b}"
  consider "x \<le> y" | "y \<le> x" by linarith
  then show "dist (f x) (f y) \<le> M * dist x y"
    apply (cases)
    using *[OF _ \<open>x \<in> {a..b}\<close> \<open>y \<in> {a..b}\<close>] *[OF _ \<open>y \<in> {a..b}\<close> \<open>x \<in> {a..b}\<close>]
    by (auto simp add: dist_commute dist_real_def)
qed

text \<open>We deduce that if a function is Lipschitz on finitely many closed sets on the real line, then
it is Lipschitz on any interval contained in their union. The difficulty in the proof is to show
that any point \<open>z\<close> in this interval (except the maximum) has a point arbitrarily close to it on its
right which is contained in a common initial closed set. Otherwise, we show that there is a small
interval \<open>(z, T)\<close> which does not intersect any of the initial closed sets, a contradiction.\<close>

proposition lipschitz_on_closed_Union:
  assumes "\<And>i. i \<in> I \<Longrightarrow> lipschitz_on M (U i) f"
          "\<And>i. i \<in> I \<Longrightarrow> closed (U i)"
          "finite I"
          "M \<ge> 0"
          "{u..(v::real)} \<subseteq> (\<Union>i\<in>I. U i)"
  shows "lipschitz_on M {u..v} f"
proof (rule locally_lipschitz_imp_lipschitz[OF _ _ \<open>M \<ge> 0\<close>])
  have *: "continuous_on (U i) f" if "i \<in> I" for i
    by (rule lipschitz_on_continuous_on[OF assms(1)[OF \<open>i\<in> I\<close>]])
  have "continuous_on (\<Union>i\<in>I. U i) f"
    apply (rule continuous_on_closed_Union) using \<open>finite I\<close> * assms(2) by auto
  then show "continuous_on {u..v} f"
    using \<open>{u..(v::real)} \<subseteq> (\<Union>i\<in>I. U i)\<close> continuous_on_subset by auto

  fix z Z assume z: "z \<in> {u..<v}" "z < Z"
  then have "u \<le> v" by auto
  define T where "T = min Z v"
  then have T: "T > z" "T \<le> v" "T \<ge> u" "T \<le> Z" using z by auto
  define A where "A = (\<Union>i\<in> I \<inter> {i. U i \<inter> {z<..T} \<noteq> {}}. U i \<inter> {z..T})"
  have a: "closed A"
    unfolding A_def apply (rule closed_UN) using \<open>finite I\<close> \<open>\<And>i. i \<in> I \<Longrightarrow> closed (U i)\<close> by auto
  have b: "bdd_below A" unfolding A_def using \<open>finite I\<close> by auto
  have "\<exists>i \<in> I. T \<in> U i" using \<open>{u..v} \<subseteq> (\<Union>i\<in>I. U i)\<close> T by auto
  then have c: "T \<in> A" unfolding A_def using T by (auto, fastforce)
  have "Inf A \<ge> z"
    apply (rule cInf_greatest, auto) using c unfolding A_def by auto
  moreover have "Inf A \<le> z"
  proof (rule ccontr)
    assume "\<not>(Inf A \<le> z)"
    then obtain w where w: "w > z" "w < Inf A" by (meson dense not_le_imp_less)
    have "Inf A \<le> T" using a b c by (simp add: cInf_lower)
    then have "w \<le> T" using w by auto
    then have "w \<in> {u..v}" using w \<open>z \<in> {u..<v}\<close> T by auto
    then obtain j where j: "j \<in> I" "w \<in> U j" using \<open>{u..v} \<subseteq> (\<Union>i\<in>I. U i)\<close> by fastforce
    then have "w \<in> U j \<inter> {z..T}" "U j \<inter> {z<..T} \<noteq> {}" using j T w \<open>w \<le> T\<close> by auto
    then have "w \<in> A" unfolding A_def using \<open>j \<in> I\<close> by auto
    then have "Inf A \<le> w" using a b by (simp add: cInf_lower)
    then show False using w by auto
  qed
  ultimately have "Inf A = z" by simp
  moreover have "Inf A \<in> A"
    apply (rule closed_contains_Inf) using a b c by auto
  ultimately have "z \<in> A" by simp
  then obtain i where i: "i \<in> I" "U i \<inter> {z<..T} \<noteq> {}" "z \<in> U i" unfolding A_def by auto
  then obtain t where "t \<in> U i \<inter> {z<..T}" by blast
  then have "dist (f t) (f z) \<le> M * (t - z)"
    using lipschitz_onD(1)[OF assms(1)[of i], of t z] i dist_real_def by auto
  then show "\<exists>t\<in>{z<..Z}. dist (f t) (f z) \<le> M * (t - z)" using \<open>T \<le> Z\<close> \<open>t \<in> U i \<inter> {z<..T}\<close> by auto
qed

subsection \<open>Local Lipschitz continuity (uniform for a family of functions)\<close>

definition\<^marker>\<open>tag important\<close> local_lipschitz::
  "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c::metric_space) \<Rightarrow> bool"
  where
  "local_lipschitz T X f \<equiv> \<forall>x \<in> X. \<forall>t \<in> T.
    \<exists>u>0. \<exists>L. \<forall>t \<in> cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"

lemma local_lipschitzI:
  assumes "\<And>t x. t \<in> T \<Longrightarrow> x \<in> X \<Longrightarrow> \<exists>u>0. \<exists>L. \<forall>t \<in> cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"
  shows "local_lipschitz T X f"
  using assms
  unfolding local_lipschitz_def
  by auto

lemma local_lipschitzE:
  assumes local_lipschitz: "local_lipschitz T X f"
  assumes "t \<in> T" "x \<in> X"
  obtains u L where "u > 0" "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
  using assms local_lipschitz_def
  by metis

lemma local_lipschitz_continuous_on:
  assumes local_lipschitz: "local_lipschitz T X f"
  assumes "t \<in> T"
  shows "continuous_on X (f t)"
  unfolding continuous_on_def
proof safe
  fix x assume "x \<in> X"
  from local_lipschitzE[OF local_lipschitz \<open>t \<in> T\<close> \<open>x \<in> X\<close>] obtain u L
    where "0 < u"
    and L: "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
    by metis
  have "x \<in> ball x u" using \<open>0 < u\<close> by simp
  from lipschitz_on_continuous_on[OF L]
  have tendsto: "(f t \<longlongrightarrow> f t x) (at x within cball x u \<inter> X)"
    using \<open>0 < u\<close> \<open>x \<in> X\<close> \<open>t \<in> T\<close>
    by (auto simp: continuous_on_def)
  moreover have "\<forall>\<^sub>F xa in at x. (xa \<in> cball x u \<inter> X) = (xa \<in> X)"
    using eventually_at_ball[OF \<open>0 < u\<close>, of x UNIV]
    by eventually_elim auto
  ultimately show "(f t \<longlongrightarrow> f t x) (at x within X)"
    by (rule Lim_transform_within_set)
qed

lemma
  local_lipschitz_compose1:
  assumes ll: "local_lipschitz (g ` T) X (\<lambda>t. f t)"
  assumes g: "continuous_on T g"
  shows "local_lipschitz T X (\<lambda>t. f (g t))"
proof (rule local_lipschitzI)
  fix t x
  assume "t \<in> T" "x \<in> X"
  then have "g t \<in> g ` T" by simp
  from local_lipschitzE[OF assms(1) this \<open>x \<in> X\<close>]
  obtain u L where "0 < u" and l: "(\<And>s. s \<in> cball (g t) u \<inter> g ` T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s))"
    by auto
  from g[unfolded continuous_on_eq_continuous_within, rule_format, OF \<open>t \<in> T\<close>,
    unfolded continuous_within_eps_delta, rule_format, OF \<open>0 < u\<close>]
  obtain d where d: "d>0" "\<And>x'. x'\<in>T \<Longrightarrow> dist x' t < d \<Longrightarrow> dist (g x') (g t) < u"
    by (auto)
  show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on  (cball x u \<inter> X) (f (g t))"
    using d \<open>0 < u\<close>
    by (fastforce intro: exI[where x="(min d u)/2"] exI[where x=L]
      intro!: less_imp_le[OF d(2)] lipschitz_on_subset[OF l] simp: dist_commute)
qed

context
  fixes T::"'a::metric_space set" and X f
  assumes local_lipschitz: "local_lipschitz T X f"
begin

lemma continuous_on_TimesI:
  assumes y: "\<And>x. x \<in> X \<Longrightarrow> continuous_on T (\<lambda>t. f t x)"
  shows "continuous_on (T \<times> X) (\<lambda>(t, x). f t x)"
  unfolding continuous_on_iff
proof (safe, simp)
  fix a b and e::real
  assume H: "a \<in> T" "b \<in> X" "0 < e"
  hence "0 < e/2" by simp
  from y[unfolded continuous_on_iff, OF \<open>b \<in> X\<close>, rule_format, OF \<open>a \<in> T\<close> \<open>0 < e/2\<close>]
  obtain d where d: "d > 0" "\<And>t. t \<in> T \<Longrightarrow> dist t a < d \<Longrightarrow> dist (f t b) (f a b) < e/2"
    by auto

  from \<open>a : T\<close> \<open>b \<in> X\<close>
  obtain u L where u: "0 < u"
    and L: "\<And>t. t \<in> cball a u \<inter> T \<Longrightarrow> L-lipschitz_on  (cball b u \<inter> X) (f t)"
    by (erule local_lipschitzE[OF local_lipschitz])

  have "a \<in> cball a u \<inter> T" by (auto simp: \<open>0 < u\<close> \<open>a \<in> T\<close> less_imp_le)
  from lipschitz_on_nonneg[OF L[OF \<open>a \<in> cball _ _ \<inter> _\<close>]] have "0 \<le> L" .

  let ?d = "Min {d, u, (e/2/(L + 1))}"
  show "\<exists>d>0. \<forall>x\<in>T. \<forall>y\<in>X. dist (x, y) (a, b) < d \<longrightarrow> dist (f x y) (f a b) < e"
  proof (rule exI[where x = ?d], safe)
    show "0 < ?d"
      using \<open>0 \<le> L\<close> \<open>0 < u\<close> \<open>0 < e\<close> \<open>0 < d\<close>
      by (auto intro!: divide_pos_pos )
    fix x y
    assume "x \<in> T" "y \<in> X"
    assume dist_less: "dist (x, y) (a, b) < ?d"
    have "dist y b \<le> dist (x, y) (a, b)"
      using dist_snd_le[of "(x, y)" "(a, b)"]
      by auto
    also
    note dist_less
    also
    {
      note calculation
      also have "?d \<le> u" by simp
      finally have "dist y b < u" .
    }
    have "?d \<le> e/2/(L + 1)" by simp
    also have "(L + 1) * \<dots> \<le> e / 2"
      using \<open>0 < e\<close> \<open>L \<ge> 0\<close>
      by (auto simp: field_split_simps)
    finally have le1: "(L + 1) * dist y b < e / 2" using \<open>L \<ge> 0\<close> by simp

    have "dist x a \<le> dist (x, y) (a, b)"
      using dist_fst_le[of "(x, y)" "(a, b)"]
      by auto
    also note dist_less
    finally have "dist x a < ?d" .
    also have "?d \<le> d" by simp
    finally have "dist x a < d" .
    note \<open>dist x a < ?d\<close>
    also have "?d \<le> u" by simp
    finally have "dist x a < u" .
    then have "x \<in> cball a u \<inter> T"
      using \<open>x \<in> T\<close>
      by (auto simp: dist_commute)
    have "dist (f x y) (f a b) \<le> dist (f x y) (f x b) + dist (f x b) (f a b)"
      by (rule dist_triangle)
    also have "(L + 1)-lipschitz_on (cball b u \<inter> X) (f x)"
      using L[OF \<open>x \<in> cball a u \<inter> T\<close>]
      by (rule lipschitz_on_le) simp
    then have "dist (f x y) (f x b) \<le> (L + 1) * dist y b"
      apply (rule lipschitz_onD)
      subgoal
        using \<open>y \<in> X\<close> \<open>dist y b < u\<close>
        by (simp add: dist_commute)
      subgoal
        using \<open>0 < u\<close> \<open>b \<in> X\<close>
        by simp
      done
    also have "(L + 1) * dist y b \<le> e / 2"
      using le1 \<open>0 \<le> L\<close> by simp
    also have "dist (f x b) (f a b) < e / 2"
      by (rule d; fact)
    also have "e / 2 + e / 2 = e" by simp
    finally show "dist (f x y) (f a b) < e" by simp
  qed
qed

lemma local_lipschitz_compact_implies_lipschitz:
  assumes "compact X" "compact T"
  assumes cont: "\<And>x. x \<in> X \<Longrightarrow> continuous_on T (\<lambda>t. f t x)"
  obtains L where "\<And>t. t \<in> T \<Longrightarrow> L-lipschitz_on X (f t)"
proof -
  {
    assume *: "\<And>n::nat. \<not>(\<forall>t\<in>T. n-lipschitz_on X (f t))"
    {
      fix n::nat
      from *[of n] have "\<exists>x y t. t \<in> T \<and> x \<in> X \<and> y \<in> X \<and> dist (f t y) (f t x) > n * dist y x"
        by (force simp: lipschitz_on_def)
    } then obtain t and x y::"nat \<Rightarrow> 'b" where xy: "\<And>n. x n \<in> X" "\<And>n. y n \<in> X"
      and t: "\<And>n. t n \<in> T"
      and d: "\<And>n. dist (f (t n) (y n)) (f (t n) (x n)) > n * dist (y n) (x n)"
      by metis
    from xy assms obtain lx rx where lx': "lx \<in> X" "strict_mono (rx :: nat \<Rightarrow> nat)" "(x o rx) \<longlonglongrightarrow> lx"
      by (metis compact_def)
    with xy have "\<And>n. (y o rx) n \<in> X" by auto
    with assms obtain ly ry where ly': "ly \<in> X" "strict_mono (ry :: nat \<Rightarrow> nat)" "((y o rx) o ry) \<longlonglongrightarrow> ly"
      by (metis compact_def)
    with t have "\<And>n. ((t o rx) o ry) n \<in> T" by simp
    with assms obtain lt rt where lt': "lt \<in> T" "strict_mono (rt :: nat \<Rightarrow> nat)" "(((t o rx) o ry) o rt) \<longlonglongrightarrow> lt"
      by (metis compact_def)
    from lx' ly'
    have lx: "(x o (rx o ry o rt)) \<longlonglongrightarrow> lx" (is "?x \<longlonglongrightarrow> _")
      and ly: "(y o (rx o ry o rt)) \<longlonglongrightarrow> ly" (is "?y \<longlonglongrightarrow> _")
      and lt: "(t o (rx o ry o rt)) \<longlonglongrightarrow> lt" (is "?t \<longlonglongrightarrow> _")
      subgoal by (simp add: LIMSEQ_subseq_LIMSEQ o_assoc lt'(2))
      subgoal by (simp add: LIMSEQ_subseq_LIMSEQ ly'(3) o_assoc lt'(2))
      subgoal by (simp add: o_assoc lt'(3))
      done
    hence "(\<lambda>n. dist (?y n) (?x n)) \<longlonglongrightarrow> dist ly lx"
      by (metis tendsto_dist)
    moreover
    let ?S = "(\<lambda>(t, x). f t x) ` (T \<times> X)"
    have "eventually (\<lambda>n::nat. n > 0) sequentially"
      by (metis eventually_at_top_dense)
    hence "eventually (\<lambda>n. norm (dist (?y n) (?x n)) \<le> norm (\<bar>diameter ?S\<bar> / n) * 1) sequentially"
    proof eventually_elim
      case (elim n)
      have "0 < rx (ry (rt n))" using \<open>0 < n\<close>
        by (metis dual_order.strict_trans1 lt'(2) lx'(2) ly'(2) seq_suble)
      have compact: "compact ?S"
        by (auto intro!: compact_continuous_image continuous_on_subset[OF continuous_on_TimesI]
          compact_Times \<open>compact X\<close> \<open>compact T\<close> cont)
      have "norm (dist (?y n) (?x n)) = dist (?y n) (?x n)" by simp
      also
      from this elim d[of "rx (ry (rt n))"]
      have "\<dots> < dist (f (?t n) (?y n)) (f (?t n) (?x n)) / rx (ry (rt (n)))"
        using lx'(2) ly'(2) lt'(2) \<open>0 < rx _\<close>
        by (auto simp add: field_split_simps strict_mono_def)
      also have "\<dots> \<le> diameter ?S / n"
      proof (rule frac_le)
        show "diameter ?S \<ge> 0"
          using compact compact_imp_bounded diameter_ge_0 by blast
        show "dist (f (?t n) (?y n)) (f (?t n) (?x n)) \<le> diameter ((\<lambda>(t,x). f t x) ` (T \<times> X))"
          by (metis (no_types) compact compact_imp_bounded diameter_bounded_bound image_eqI mem_Sigma_iff o_apply split_conv t xy(1) xy(2))
        show "real n \<le> real (rx (ry (rt n)))"
          by (meson le_trans lt'(2) lx'(2) ly'(2) of_nat_mono strict_mono_imp_increasing)
      qed (use \<open>n > 0\<close> in auto)
      also have "\<dots> \<le> abs (diameter ?S) / n"
        by (auto intro!: divide_right_mono)
      finally show ?case by simp
    qed
    with _ have "(\<lambda>n. dist (?y n) (?x n)) \<longlonglongrightarrow> 0"
      by (rule tendsto_0_le)
        (metis tendsto_divide_0[OF tendsto_const] filterlim_at_top_imp_at_infinity
          filterlim_real_sequentially)
    ultimately have "lx = ly"
      using LIMSEQ_unique by fastforce
    with assms lx' have "lx \<in> X" by auto
    from \<open>lt \<in> T\<close> this obtain u L where L: "u > 0" "\<And>t. t \<in> cball lt u \<inter> T \<Longrightarrow> L-lipschitz_on (cball lx u \<inter> X) (f t)"
      by (erule local_lipschitzE[OF local_lipschitz])
    hence "L \<ge> 0" by (force intro!: lipschitz_on_nonneg \<open>lt \<in> T\<close>)

    from L lt ly lx \<open>lx = ly\<close>
    have
      "eventually (\<lambda>n. ?t n \<in> ball lt u) sequentially"
      "eventually (\<lambda>n. ?y n \<in> ball lx u) sequentially"
      "eventually (\<lambda>n. ?x n \<in> ball lx u) sequentially"
      by (auto simp: dist_commute Lim)
    moreover have "eventually (\<lambda>n. n > L) sequentially"
      by (metis filterlim_at_top_dense filterlim_real_sequentially)
    ultimately
    have "eventually (\<lambda>_. False) sequentially"
    proof eventually_elim
      case (elim n)
      hence "dist (f (?t n) (?y n)) (f (?t n) (?x n)) \<le> L * dist (?y n) (?x n)"
        using assms xy t
        unfolding dist_norm[symmetric]
        by (intro lipschitz_onD[OF L(2)]) (auto)
      also have "\<dots> \<le> n * dist (?y n) (?x n)"
        using elim by (intro mult_right_mono) auto
      also have "\<dots> \<le> rx (ry (rt n)) * dist (?y n) (?x n)"
        by (intro mult_right_mono[OF _ zero_le_dist])
           (meson lt'(2) lx'(2) ly'(2) of_nat_le_iff order_trans seq_suble)
      also have "\<dots> < dist (f (?t n) (?y n)) (f (?t n) (?x n))"
        by (auto intro!: d)
      finally show ?case by simp
    qed
    hence False
      by simp
  } then obtain L where "\<And>t. t \<in> T \<Longrightarrow> L-lipschitz_on X (f t)"
    by metis
  thus ?thesis ..
qed

lemma local_lipschitz_subset:
  assumes "S \<subseteq> T" "Y \<subseteq> X"
  shows "local_lipschitz S Y f"
proof (rule local_lipschitzI)
  fix t x assume "t \<in> S" "x \<in> Y"
  then have "t \<in> T" "x \<in> X" using assms by auto
  from local_lipschitzE[OF local_lipschitz, OF this]
  obtain u L where u: "0 < u" and L: "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
    by blast
  show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> S. L-lipschitz_on (cball x u \<inter> Y) (f t)"
    using assms
    by (auto intro: exI[where x=u] exI[where x=L]
        intro!: u lipschitz_on_subset[OF _ Int_mono[OF order_refl \<open>Y \<subseteq> X\<close>]] L)
qed

end

lemma local_lipschitz_minus:
  fixes f::"'a::metric_space \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
  shows "local_lipschitz T X (\<lambda>t x. - f t x) = local_lipschitz T X f"
  by (auto simp: local_lipschitz_def lipschitz_on_minus)

lemma local_lipschitz_PairI:
  assumes f: "local_lipschitz A B (\<lambda>a b. f a b)"
  assumes g: "local_lipschitz A B (\<lambda>a b. g a b)"
  shows "local_lipschitz A B (\<lambda>a b. (f a b, g a b))"
proof (rule local_lipschitzI)
  fix t x assume "t \<in> A" "x \<in> B"
  from local_lipschitzE[OF f this] local_lipschitzE[OF g this]
  obtain u L v M where "0 < u" "(\<And>s. s \<in> cball t u \<inter> A \<Longrightarrow> L-lipschitz_on (cball x u \<inter> B) (f s))"
    "0 < v" "(\<And>s. s \<in> cball t v \<inter> A \<Longrightarrow> M-lipschitz_on (cball x v \<inter> B) (g s))"
    by metis
  then show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> A. L-lipschitz_on (cball x u \<inter> B) (\<lambda>b. (f t b, g t b))"
    by (intro exI[where x="min u v"])
      (force intro: lipschitz_on_subset intro!: lipschitz_on_Pair)
qed

lemma local_lipschitz_constI: "local_lipschitz S T (\<lambda>t x. f t)"
  by (auto simp: intro!: local_lipschitzI lipschitz_on_constant intro: exI[where x=1])

lemma (in bounded_linear) local_lipschitzI:
  shows "local_lipschitz A B (\<lambda>_. f)"
proof (rule local_lipschitzI, goal_cases)
  case (1 t x)
  from lipschitz_boundE[of "(cball x 1 \<inter> B)"] obtain C where "C-lipschitz_on (cball x 1 \<inter> B) f" by auto
  then show ?case
    by (auto intro: exI[where x=1])
qed

proposition c1_implies_local_lipschitz:
  fixes T::"real set" and X::"'a::{banach,heine_borel} set"
    and f::"real \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes f': "\<And>t x. t \<in> T \<Longrightarrow> x \<in> X \<Longrightarrow> (f t has_derivative blinfun_apply (f' (t, x))) (at x)"
  assumes cont_f': "continuous_on (T \<times> X) f'"
  assumes "open T"
  assumes "open X"
  shows "local_lipschitz T X f"
proof (rule local_lipschitzI)
  fix t x
  assume "t \<in> T" "x \<in> X"
  from open_contains_cball[THEN iffD1, OF \<open>open X\<close>, rule_format, OF \<open>x \<in> X\<close>]
  obtain u where u: "u > 0" "cball x u \<subseteq> X" by auto
  moreover
  from open_contains_cball[THEN iffD1, OF \<open>open T\<close>, rule_format, OF \<open>t \<in> T\<close>]
  obtain v where v: "v > 0" "cball t v \<subseteq> T" by auto
  ultimately
  have "compact (cball t v \<times> cball x u)" "cball t v \<times> cball x u \<subseteq> T \<times> X"
    by (auto intro!: compact_Times)
  then have "compact (f' ` (cball t v \<times> cball x u))"
    by (auto intro!: compact_continuous_image continuous_on_subset[OF cont_f'])
  then obtain B where B: "B > 0" "\<And>s y. s \<in> cball t v \<Longrightarrow> y \<in> cball x u \<Longrightarrow> norm (f' (s, y)) \<le> B"
    by (auto dest!: compact_imp_bounded simp: bounded_pos)

  have lipschitz: "B-lipschitz_on (cball x (min u v) \<inter> X) (f s)" if s: "s \<in> cball t v" for s
  proof -
    note s
    also note \<open>cball t v \<subseteq> T\<close>
    finally
    have deriv: "\<And>y. y \<in> cball x u \<Longrightarrow> (f s has_derivative blinfun_apply (f' (s, y))) (at y within cball x u)"
      using \<open>_ \<subseteq> X\<close>
      by (auto intro!: has_derivative_at_withinI[OF f'])
    have "norm (f s y - f s z) \<le> B * norm (y - z)"
      if "y \<in> cball x u" "z \<in> cball x u"
      for y z
      using s that
      by (intro differentiable_bound[OF convex_cball deriv])
        (auto intro!: B  simp: norm_blinfun.rep_eq[symmetric])
    then show ?thesis
      using \<open>0 < B\<close>
      by (auto intro!: lipschitz_onI simp: dist_norm)
  qed
  show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"
    by (force intro: exI[where x="min u v"] exI[where x=B] intro!: lipschitz simp: u v)
qed

end


(* Title:     Transcendence_Series.thy
   Authors:   Angeliki Koutsoukou-Argyraki and Wenda Li, University of Cambridge
*)

section \<open>The transcendence of certain infinite series\<close>
theory "Transcendence_Series" imports
    "HOL-Analysis.Multivariate_Analysis"
    "HOL-Computational_Algebra.Polynomial"
    Prime_Number_Theorem.Prime_Number_Theorem_Library
begin

text \<open>
We formalise the proofs of two transcendence criteria by J. Han\v{c}l and P. Rucki that
assert the transcendence of the sums of certain infinite series built up by sequences that
fulfil certain properties (Theorems 2.1 and 2.2 in \cite{hancl2005}, HanclRucki1 and HanclRucki2
here respectively). Both proofs make use of Roth's celebrated theorem on diophantine approximations
to algebraic numbers from 1955 \cite{roth_1955} which we assume and implement within the locale
RothsTheorem.

A small mistake was detected in the original proof of Theorem 2.1, and the authors suggested
to us a fix for the problem (in communication by email).
Our formalised proof incorporates this correction (see the Remark in the proof of HanclRucki1).
\<close>

subsection \<open>Misc\<close>

lemma powr_less_inverse_iff:
  fixes x y z::real
  assumes "x>0""y>0""z>0"
  shows "x powr y < z \<longleftrightarrow> x < z powr (inverse y)"
proof
  assume "x powr y < z"
  from powr_less_mono2[OF _ _ this,of "inverse y"]
  show "x < z powr inverse y"
    using assms by (auto simp:powr_powr)
next
  assume *:"x < z powr inverse y"
  from powr_less_mono2[OF _ _ *,of y] show "x powr y < z"
    using assms by (auto simp:powr_powr)
qed

lemma powr_less_inverse_iff':
  fixes x y z::real
  assumes "x>0""y>0""z>0"
  shows "z< x powr y \<longleftrightarrow> z powr (inverse y) < x"
  using powr_less_inverse_iff[symmetric,of _ "inverse y"] assms by auto

lemma powr_less_eq_inverse_iff:
  fixes x y z::real
  assumes "x>0""y>0""z>0"
  shows "x powr y \<le> z \<longleftrightarrow> x \<le> z powr (inverse y)"
  by (meson assms(1) assms(2) assms(3) not_less powr_less_inverse_iff')

lemma powr_less_eq_inverse_iff':
  fixes x y z::real
  assumes "x>0""y>0""z>0"
  shows "z\<le> x powr y \<longleftrightarrow> z powr (inverse y) \<le> x"
  by (simp add: assms(1) assms(2) assms(3) powr_less_eq_inverse_iff)

lemma tendsto_PInfty_mono:
  assumes "(ereal o f) \<longlonglongrightarrow> \<infinity>" "\<forall>\<^sub>F x in sequentially. f x \<le> g x"
  shows "(ereal o g) \<longlonglongrightarrow> \<infinity>"
  using assms unfolding comp_def tendsto_PInfty_eq_at_top
  by (elim filterlim_at_top_mono, simp)

lemma limsup_infinity_imp_Inf_many:
  assumes "limsup f = \<infinity>"
  shows "(\<forall> m. (\<exists>\<^sub>\<infinity>i. f i > ereal m))" unfolding INFM_nat
proof (clarify,rule ccontr)
  fix m k assume "\<not> (\<exists>n>k. ereal m < f n)"
  then have "\<forall>n>k. f n \<le> ereal m" by auto
  then have "\<forall>\<^sub>F n in sequentially. f n \<le> ereal m"
    using eventually_at_top_dense by blast
  then have "limsup f \<le> ereal m" using Limsup_bounded by auto
  then show False using assms by simp
qed

lemma snd_quotient_plus_leq:
  defines "de\<equiv>(snd o quotient_of)"
  shows "de (x+y) \<le> de x * de y "
proof -
  obtain x1 x2 y1 y2 where xy: "quotient_of x = (x1,x2)" "quotient_of y=(y1,y2)"
    by (meson surj_pair)
  have "x2>0" "y2>0" using xy quotient_of_denom_pos by blast+
  then show ?thesis
    unfolding de_def comp_def rat_plus_code xy
    apply (auto split:prod.split simp:Rat.normalize_def Let_def)
    by (smt div_by_1 gcd_pos_int int_div_less_self mult_eq_0_iff mult_sign_intros(1))
qed

lemma quotient_of_inj: "inj quotient_of"
  unfolding inj_def by (simp add: quotient_of_inject)

lemma infinite_inj_imageE:
  assumes "infinite A" "inj_on f A" "f ` A \<subseteq> B"
  shows "infinite B"
  using assms inj_on_finite by blast

lemma incseq_tendsto_limsup:
  fixes f::"nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
  assumes "incseq f"
  shows "f \<longlonglongrightarrow> limsup f"
  using LIMSEQ_SUP assms convergent_def convergent_ereal tendsto_Limsup
          trivial_limit_sequentially by blast

subsection \<open>Main proofs\<close>

text \<open>Since the proof of Roths theorem has not been formalized yet, we implement it into a locale
      and used it as an assumption.\<close>
locale RothsTheorem =
  assumes RothsTheorem:"\<forall>\<xi> \<kappa>. algebraic \<xi> \<and> \<xi> \<notin> \<rat> \<and> infinite {(p,q). q>0 \<and>
            coprime p q \<and> \<bar>\<xi> - of_int p / of_int q\<bar> < 1 / q powr \<kappa>} \<longrightarrow> \<kappa> \<le> 2"

theorem (in RothsTheorem) HanclRucki1:
  fixes a b ::"nat\<Rightarrow>int" and \<delta> ::real
  defines "aa\<equiv>(\<lambda>n. real_of_int (a n))" and "bb\<equiv>(\<lambda>n. real_of_int (b n))"
  assumes a_pos:"\<forall> k. a k >0" and b_pos:"\<forall> k. b k >0" and "\<delta> >0"
      and limsup_infy:"limsup (\<lambda> k. aa (k+1)/(\<Prod>i = 0..k. aa i)powr(2+\<delta>)*(1/bb (k+1))) = \<infinity>"
      and liminf_1:"liminf (\<lambda>k. aa (k+1) / aa k * bb k / bb (k+1)) > 1"
  shows "\<not> algebraic(suminf  (\<lambda> k. bb k / aa k))"
proof -
  have summable:"summable (\<lambda> k. bb k / aa k)"
  proof (rule ratio_test_convergence)
    have [simp]:"aa k>0" "bb k>0" for k
      unfolding aa_def bb_def using a_pos b_pos by auto
    show "\<forall>\<^sub>F n in sequentially. 0 < bb n / aa n"
      apply (rule eventuallyI)
      by auto
    show "1 < liminf (\<lambda>n. ereal (bb n / aa n / (bb (Suc n) / aa (Suc n))))"
      using liminf_1 by (auto simp:algebra_simps)
  qed
  have [simp]: "aa k>0" "bb k>0" for k unfolding aa_def bb_def
    by (auto simp add: a_pos b_pos)
  have ab_1:"aa k\<ge>1" "bb k\<ge>1" for k
    unfolding aa_def bb_def using a_pos b_pos
    by (auto simp add: int_one_le_iff_zero_less)

  define B where "B=liminf (\<lambda>x. ereal (aa (x + 1) / aa x * bb x / bb (x + 1)))"
  define M where "M= (case B of ereal m \<Rightarrow> (m+1)/2 | _ \<Rightarrow> 2)"
  have "M > 1" "M < B"
    using liminf_1 unfolding M_def
    apply (fold B_def)
    by (cases B,auto)+

  text \<open>
Remark:
In the original proof of Theorem 2.1 in \cite{hancl2005}
it was claimed in p.534 that from assumption (3) (i.e. @{thm liminf_1}),
we obtain that:
$\forall A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $,
 however note the counterexample  where
$a_{k+1}= k (a_1 a_2 ... a_k)^{\lceil 2+ \delta \rceil}$ if k is odd, and
$a_{k+1} = 2 a_k$ otherwise, with $b_k =1$ for all $k$.
In commmunication by email the authors suggested to replace the claim
$\forall A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $
with
$\exists A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $
which solves the problem and the proof proceeds as in the paper.
The witness for $\exists A>1 $ is denoted by $M$ here.\<close>

  have bb_aa_event:"\<forall>\<^sub>F k in sequentially. (1/M)*(bb k / aa k)> bb(k+1)/ aa (k+1)"
    using less_LiminfD[OF \<open>M < B\<close>[unfolded B_def],simplified]
    apply eventually_elim
    using \<open>M > 1\<close> by (auto simp:divide_simps algebra_simps)

  have bb_aa_p:"\<forall>\<^sub>F k in sequentially. \<forall>p. bb(k+p)/ aa (k+p) \<le> (1/M^p)*(bb k / aa k)"
  proof -
    obtain k0 where k0_ineq:
        "\<forall>n\<ge>k0. bb (n + 1) / aa (n + 1) < 1 / M * (bb n / aa n)"
      using bb_aa_event unfolding eventually_sequentially
      by auto
    have "bb(k+p)/ aa (k+p) \<le> (1/M^p)*(bb k / aa k)" when "k\<ge>k0" for p k
    proof (induct p)
      case 0
      then show ?case by auto
    next
      case (Suc p)
      have " bb (k + Suc p) / aa (k + Suc p)  < 1 / M * (bb (k+p) / aa (k+p))"
        using k0_ineq[rule_format,of "k+p"] that by auto
      also have "... \<le> 1 / M ^(Suc p) * (bb k / aa k)"
        using Suc \<open>M>1\<close> by (auto simp add:field_simps)
      finally show ?case by auto
    qed
    then show ?thesis unfolding eventually_sequentially by auto
  qed

  define \<xi> where "\<xi> = suminf (\<lambda> k. bb k / aa k)"
  have \<xi>_Inf_many:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> <  1 / prod aa {0..k} powr (2 + \<delta>)"
  proof -
    have "\<bar>\<xi> - (\<Sum>i = 0..k. bb i / aa i)\<bar> = \<bar>\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))\<bar>"
      for k
      unfolding \<xi>_def
      apply (subst suminf_minus_initial_segment[of _ "k+1",OF summable])
      using atLeast0AtMost lessThan_Suc_atMost by auto

    moreover have "\<exists>\<^sub>\<infinity> k. \<bar>\<Sum>i. bb(i+(k+1))/ aa (i+(k+1))\<bar>
                            <  1 / prod aa {0..k} powr (2 + \<delta>)"
    proof -
      define P where "P = (\<lambda> i. \<forall>p. bb (i + 1 + p) / aa (i + 1 + p)
                                          \<le> 1 / M ^ p * (bb (i + 1) / aa (i + 1)))"
      define Q where "Q= (\<lambda> i. ereal (M / (M - 1))
                    < ereal (aa (i + 1) / prod aa {0..i} powr (2 + \<delta>) * (1 / bb (i + 1))))"
      have "\<forall>\<^sub>\<infinity> i. P i"
        using bb_aa_p[THEN sequentially_offset, of 1] cofinite_eq_sequentially
        unfolding P_def by auto
      moreover have "\<exists>\<^sub>\<infinity>i. Q i"
        using limsup_infy[THEN limsup_infinity_imp_Inf_many,rule_format,of "(M / (M -1))"]
        unfolding Q_def .
      moreover have "\<bar>\<Sum>i. bb(i+(k+1))/ aa (i+(k+1))\<bar>
                            <  1 / prod aa {0..k} powr (2 + \<delta>)"
        when "P k" "Q k" for k
      proof -
        have summable_M:"summable (\<lambda>i. 1 / M ^ i)"
          apply (rule summable_ratio_test[of "1/M"])
          using \<open>M>1\<close> by auto

        have "(\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1))) \<ge> 0"
          apply (rule suminf_nonneg)
          subgoal using summable_ignore_initial_segment[OF summable,of "k+1"] by auto
          subgoal by (simp add: less_imp_le)
          done
        then have "\<bar>\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1))\<bar>
                      = (\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1)))"
          by auto
        also have "... \<le> (\<Sum>i. 1 / M ^ i * (bb (k + 1) / aa (k + 1)))"
          apply (rule suminf_le)
          subgoal using that(1) unfolding P_def by (auto simp add:algebra_simps)
          subgoal using summable_ignore_initial_segment[OF summable,of "k+1"] by auto
          subgoal using summable_mult2[OF summable_M,of " bb (k + 1) / aa (k + 1)"]
            by auto
          done
        also have "... = (bb (k + 1) / aa (k + 1)) * (\<Sum>i. 1 / M ^ i)"
          using suminf_mult2[OF summable_M,of " bb (k + 1) / aa (k + 1)"]
          by (auto simp:algebra_simps)
        also have "... = (bb (k + 1) / aa (k + 1)) * (\<Sum>i. (1 / M) ^ i)"
          using \<open>M>1\<close> by (auto simp: field_simps)
        also have "... = (bb (k + 1) / aa (k + 1)) * (M / (M -1))"
          apply (subst suminf_geometric)
          using \<open>M>1\<close>  by (auto simp: field_simps)
        also have "... < (bb (k + 1) / aa (k + 1)) * (aa (k + 1) /
                            prod aa {0..k} powr (2 + \<delta>) * (1 / bb (k + 1)))"
          apply (subst mult_less_cancel_left_pos)
          using that(2) unfolding Q_def by auto
        also have "... = 1/ prod aa {0..k} powr (2 + \<delta>)"
          using ab_1[of "Suc k"] by auto
        finally show ?thesis .
      qed
      ultimately show ?thesis by (smt INFM_conjI INFM_mono)
    qed
    ultimately show ?thesis by auto
  qed

  define pq where "pq = (\<lambda>k. quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)))"
  define p q where "p = fst \<circ> pq" and "q = snd \<circ> pq"
  have coprime_pq:"coprime (p k) (q k)"
        and q_pos:"q k > 0" and pq_sum:"p k / q k = (\<Sum>i=0..k. b i / a i)" for k
  proof -
    have eq: "quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)) = (p k, q k)"
      by (simp add: p_def q_def pq_def)
    from quotient_of_coprime[OF eq] show "coprime (p k) (q k)" .
    from quotient_of_denom_pos[OF eq] show "q k > 0" .
    have "(\<Sum>i=0..k. b i / a i) = of_rat (\<Sum>i=0..k. of_int (b i) / of_int (a i))"
      by (simp add: of_rat_sum of_rat_divide)
    also have "(\<Sum>i=0..k. rat_of_int (b i) / rat_of_int (a i)) =
                 rat_of_int (p k) / rat_of_int (q k)"
      using quotient_of_div[OF eq] by simp
    finally show "p k / q k = (\<Sum>i=0..k. b i / a i)" by (simp add:of_rat_divide)
  qed

  have \<xi>_Inf_many2:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar>
                        <  1 / q k powr (2 + \<delta>)"
    using \<xi>_Inf_many
  proof (elim INFM_mono)
    fix k assume asm:"\<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> < 1 / prod aa {0..k} powr (2 + \<delta>)"
    have "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar>
              = \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>"
      using pq_sum unfolding aa_def bb_def by auto
    also have "... < 1 / prod aa {0..k} powr (2 + \<delta>)"
      using asm by auto
    also have "... \<le> 1 / q k powr (2 + \<delta>)"
    proof -
      have "q k \<le> prod aa {0..k}"
      proof (induct k)
        case 0
        then show ?case unfolding q_def pq_def aa_def
          apply (simp add:rat_divide_code of_int_rat quotient_of_Fract)
          using ab_1[of 0,unfolded aa_def bb_def] unfolding Let_def normalize_def
          apply auto
          by (metis div_by_1 gcd_pos_int less_imp_le less_trans nonneg1_imp_zdiv_pos_iff
                not_less zdiv_mono2)
      next
        case (Suc k)
        define de where "de=snd \<circ> quotient_of"
        have "real_of_int (q (Suc k))
                  = de (\<Sum>i=0..Suc k. of_int (b i) / of_int (a i))"
          unfolding q_def pq_def de_def by simp
        also have "... = de ((\<Sum>i=0..k. of_int (b i) / of_int (a i))
                                + of_int (b (Suc k)) / of_int (a (Suc k)))"
          by simp
        also have "... \<le> de (\<Sum>i=0..k. of_int (b i) / of_int (a i))
                                * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
          using snd_quotient_plus_leq[folded de_def] by presburger
        also have "... = q k * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
          unfolding q_def pq_def de_def by auto
        also have "... = q k * snd (Rat.normalize (b (Suc k), a (Suc k)))"
          by (simp add:rat_divide_code of_int_rat quotient_of_Fract de_def)
        also have "... \<le> q k * aa (Suc k)"
          using ab_1[of "Suc k"] q_pos[of "k"]
          unfolding normalize_def aa_def bb_def Let_def
          apply auto
          by (metis div_by_1 int_one_le_iff_zero_less less_trans
                  nonneg1_imp_zdiv_pos_iff not_less zdiv_mono2 zero_less_one)
        also have "... \<le>  prod aa {0..k} * aa (Suc k)"
          using Suc ab_1[of "Suc k"] by auto
        also have "... = prod aa {0..Suc k}"
          by (simp add: prod.atLeast0_atMost_Suc)
        finally show ?case .
      qed
      then show ?thesis
        by (smt \<open>0 < \<delta>\<close> frac_le of_int_0 of_int_le_iff powr_gt_zero
                  powr_mono2 q_pos)
    qed
    finally show "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar> < 1 / real_of_int (q k) powr (2 + \<delta>)" .
  qed

  define pqs where "pqs={(p, q). q>0 \<and> coprime p q
      \<and> \<bar>\<xi> - real_of_int p / real_of_int q\<bar> < 1 / q powr (2 + \<delta>)}"
  have \<xi>_infinite:"infinite pqs"
  proof -
    define A where "A={k. \<bar>\<xi> -  (p k) /  (q k)\<bar> < 1 / (q k) powr (2 + \<delta>)}"
    have "\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar> <  1 / q k powr (2 + \<delta>)"
      using \<xi>_Inf_many2 .
    then have "infinite A"
      unfolding Inf_many_def A_def by auto
    moreover have "inj_on (\<lambda>k. (p k, q k)) A"
    proof -
      define g where "g=(\<lambda>i. rat_of_int (b i) / rat_of_int (a i))"
      define f where "f=(\<lambda>k. \<Sum>i = 0..k. g i)"
      have g_pos:"g i>0" for i
        unfolding g_def by (simp add: a_pos b_pos)
      have "strict_mono f" unfolding strict_mono_def f_def
      proof safe
        fix x y::nat assume "x < y"
        then have "sum g {0..y} - sum g {0..x} = sum g {x<..y}"
          apply (subst  Groups_Big.sum_diff[symmetric])
          by (auto intro:arg_cong2[where f=sum])
        also have "... > 0"
          apply (rule ordered_comm_monoid_add_class.sum_pos)
          using \<open>x<y\<close> g_pos by auto
        finally have "sum g {0..y} - sum g {0..x} >0" .
        then show "sum g {0..x} < sum g {0..y}" by auto
      qed
      then have "inj f" using strict_mono_imp_inj_on by auto
      then have "inj (quotient_of o f)" by (simp add: inj_compose quotient_of_inj)
      then have "inj (\<lambda>k. (p k, q k))"
        unfolding f_def p_def q_def pq_def comp_def
        apply (fold g_def)
        by auto
      then show ?thesis by (auto elim:subset_inj_on)
    qed
    moreover have "(\<lambda>k. (p k, q k)) ` A \<subseteq> pqs"
      unfolding A_def pqs_def using coprime_pq q_pos by auto
    ultimately show ?thesis
      apply (elim infinite_inj_imageE)
      by auto
  qed
  moreover have "finite pqs" if "\<xi> \<in> \<rat>"
  proof -
    obtain m n where \<xi>_mn:"\<xi> = (of_int m / of_int n)" and "coprime m n" "n>0"
    proof -
      obtain m n where mn:"\<bar>\<xi>\<bar> = (of_nat m / of_nat n)" "coprime m n" "n\<noteq>0"
        using Rats_abs_nat_div_natE[OF \<open>\<xi> \<in> \<rat>\<close> Rats_abs_nat_div_natE]
        by metis
      define m' and n'::int
        where "m'=(if \<xi> > 0 then nat m else -nat m)" and "n'=nat n"
      then have "\<xi> = (of_int m' / of_int n')" "coprime m' n'" "n'>0"
        using mn by auto
      then show ?thesis using that by auto
    qed
    have "pqs \<subseteq> {(m,n)} \<union> {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
    proof (rule subsetI)
      fix x assume "x \<in> pqs"
      define p q where "p=fst x" and "q=snd x"
      have "q>0" "coprime p q" and pq_less:"\<bar>\<xi> - p / q\<bar> < 1 / q powr (2 + \<delta>)"
        using \<open>x\<in>pqs\<close> unfolding p_def q_def pqs_def by auto
      have q_lt_n:"q<n" when "m\<noteq>p \<or> n\<noteq>q"
      proof -
        have "m * q \<noteq> n * p" using that \<open>coprime m n\<close> \<open>coprime p q\<close> \<open>q>0\<close> \<open>n>0\<close>
          by (metis eq_rat(1) fst_conv int_one_le_iff_zero_less mult.commute normalize_stable
                not_one_le_zero quotient_of_Fract snd_conv)
        then have "1/(n*q) \<le> \<bar>m/n - p/q\<bar>"
          using \<open>q>0\<close> \<open>n>0\<close>
          apply (auto simp:field_simps)
          by (metis add_diff_cancel_left' diff_diff_eq2 diff_zero less_irrefl not_le of_int_diff
                of_int_lessD of_int_mult)
        also have "...  < 1 / q powr (2 + \<delta>)"
          using pq_less unfolding \<xi>_mn by auto
        also have "... \<le> 1 / q ^2"
        proof -
          have "real_of_int (q\<^sup>2) = q powr 2"
            apply (subst powr_numeral)
            unfolding power2_eq_square using \<open>q>0\<close> by auto
          also have "... \<le> q powr (2 + \<delta>)"
            apply (rule powr_mono)
            using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
          finally have "real_of_int (q\<^sup>2) \<le> real_of_int q powr (2 + \<delta>)" .
          moreover have "real_of_int q powr (2 + \<delta>) > 0" using \<open>0 < q\<close> by auto
          ultimately show ?thesis by (auto simp:field_simps)
        qed
        finally have " 1 /  (n * q) < 1 / q\<^sup>2" .
        then show ?thesis  using \<open>q>0\<close> \<open>n>0\<close>
          unfolding power2_eq_square by (auto simp:field_simps)
      qed
      moreover have "- \<bar>m\<bar> - 1 \<le> p \<and> p \<le> \<bar>m\<bar> + 1" when "m\<noteq>p \<or> n\<noteq>q"
      proof -
        define qn where "qn=q/n"
        have "0<qn" "qn<1" unfolding qn_def using q_lt_n[OF \<open>m\<noteq>p \<or> n\<noteq>q\<close>] \<open>q>0\<close> by auto

        have "\<bar>m/n - p / q\<bar> < 1 / q powr (2 + \<delta>)" using pq_less unfolding \<xi>_mn by simp
        then have "\<bar>p / q - m/n\<bar> < 1 / q powr (2 + \<delta>)" by simp
        then have " m/n- 1 / q powr (2 + \<delta>) < p/q \<and> p/q < m/n + 1 / q powr (2 + \<delta>)"
          unfolding abs_diff_less_iff by auto
        then have "qn*m- q / q powr (2 + \<delta>) < p \<and> p < qn*m + q / q powr (2 + \<delta>)"
          unfolding qn_def using \<open>q>0\<close> by (auto simp:field_simps)
        moreover have "- \<bar>m\<bar> - 1 \<le> qn*m- q / q powr (2 + \<delta>)"
        proof -
          have "- \<bar>m\<bar> \<le> qn*m" using \<open>0<qn\<close> \<open>qn<1\<close>
            apply (cases "m\<ge>0")
            subgoal
              apply simp
              by (meson less_eq_real_def mult_nonneg_nonneg neg_le_0_iff_le of_int_0_le_iff order_trans)
            subgoal by simp
            done
          moreover have "- 1 \<le> - q / q powr (2 + \<delta>)"
          proof -
            have "q = q powr 1" using \<open>0 < q\<close> by auto
            also have "... \<le>q powr (2 + \<delta>)"
              apply (rule powr_mono)
              using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
            finally have "q \<le> q powr (2 + \<delta>)" .
            then show ?thesis using \<open>0 < q\<close> by auto
          qed
          ultimately show ?thesis by auto
        qed
        moreover have "qn*m + q / q powr (2 + \<delta>) \<le> \<bar>m\<bar> + 1"
        proof -
          have "qn*m \<le> \<bar>m\<bar>" using \<open>0<qn\<close> \<open>qn<1\<close>
            apply (cases "m\<ge>0")
            subgoal by (simp add: mult_left_le_one_le)
            subgoal by (smt of_int_0_le_iff zero_le_mult_iff)
            done
          moreover have "q / q powr (2 + \<delta>) \<le> 1"
          proof -
            have "q = q powr 1" using \<open>0 < q\<close> by auto
            also have "... \<le>q powr (2 + \<delta>)"
              apply (rule powr_mono)
              using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
            finally have "q \<le> q powr (2 + \<delta>)" .
            then show ?thesis using \<open>0 < q\<close> by auto
          qed
          ultimately show ?thesis by auto
        qed
        ultimately show ?thesis by auto
      qed
      ultimately show "x \<in> {(m, n)} \<union> {x \<in> pqs. - \<bar>m\<bar> - 1 \<le> fst x \<and> fst x \<le> \<bar>m\<bar> + 1
                          \<and> 0 < snd x \<and> snd x < n}"
        using \<open>x \<in> pqs\<close> \<open>q>0\<close> unfolding p_def q_def by force
    qed
    moreover have "finite {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
    proof -
      have "finite ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})" by blast
      moreover have "{x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n } \<subseteq>
                ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})"
        by auto
      ultimately show ?thesis
        apply (elim rev_finite_subset)
        by blast
    qed
    ultimately show ?thesis using finite_subset by auto
  qed
  ultimately show ?thesis
    apply (fold \<xi>_def)
    using RothsTheorem[rule_format,of \<xi> "2 + \<delta>",folded pqs_def] \<open>\<delta> >0\<close> by auto
qed

theorem (in RothsTheorem) HanclRucki2:
  fixes a b ::"nat\<Rightarrow>int" and \<delta> \<epsilon> ::real
  defines "aa\<equiv>(\<lambda>n. real_of_int (a n))" and "bb\<equiv>(\<lambda>n. real_of_int (b n))"
  assumes a_pos:"\<forall> k. a k >0" and b_pos:"\<forall> k. b k >0" and "\<delta> >0"
    and "\<epsilon> >0"
    and limsup_infi:"limsup (\<lambda> k.(aa (k+1)/(\<Prod>i = 0..k. aa i)powr(2+(2/\<epsilon>) + \<delta>))
          * (1/(bb (k+1)))) = \<infinity>"
    and ratio_large:"\<forall> k. ( k \<ge> t \<longrightarrow>  (( aa(k+1)/bb( k+1)) ) powr(1/(1+\<epsilon>))
              \<ge>  (( aa k/bb k) powr(1/(1+\<epsilon>)))+1)"
  shows "\<not> algebraic(suminf (\<lambda> k. bb k /aa k))  "
proof-
  have aa_bb_pos[simp]:"aa k>0" "bb k>0" for k
    unfolding aa_def bb_def using a_pos b_pos by auto
  have summable:"summable (\<lambda> k. bb k / aa k)"
  proof -
    define c0 where "c0\<equiv>(aa t/bb t) powr(1/(1+\<epsilon>)) - t"
    have ab_k:"(aa k / bb k) powr(1/(1+\<epsilon>)) \<ge> k + c0" when "k\<ge>t" for k
      using that
    proof (induct k)
      case 0
      then show ?case unfolding c0_def by simp
    next
      case (Suc k)
      have ?case when "\<not> t\<le>k"
      proof -
        have "t = Suc k" using that Suc.prems by linarith
        then show ?thesis unfolding c0_def by auto
      qed
      moreover have ?case when "t \<le> k"
      proof -
        have "(aa(k+1)/bb(k+1)) powr(1/(1+\<epsilon>))
              \<ge> ( aa k/bb k) powr(1/(1+\<epsilon>))+1"
          using ratio_large[rule_format,OF that] by blast
        then show ?thesis using Suc(1)[OF that] by simp
      qed
      ultimately show ?case by auto
    qed
    have "summable (\<lambda>k. 1 / (k + c0) powr (1+\<epsilon>))"
    proof -
      have "c0 + t > 0" unfolding c0_def
        using aa_bb_pos[of t] by (simp,linarith)
      then have "summable (\<lambda>k. 1 / (k + (c0+t)) powr (1+\<epsilon>))"
        using summable_hurwitz_zeta_real[of "1+\<epsilon>" "c0+t"]
        apply (subst (asm) powr_minus_divide)
        using \<open>\<epsilon>>0\<close> by auto
      then show ?thesis
        apply (rule_tac summable_offset[of _ t])
        by (auto simp:algebra_simps)
    qed
    moreover have "bb k / aa k \<le> 1 / (k + c0) powr (1+\<epsilon>)" when "k\<ge>t" for k
    proof -
      have "(aa t / bb t) powr (1 / (1 + \<epsilon>)) > 0"
        apply simp
        by (metis \<open>\<And>k. 0 < aa k\<close> \<open>\<And>k. 0 < bb k\<close> less_numeral_extra(3))
      then have "k + c0 >0" unfolding c0_def using that by linarith
      then have "aa k / bb k \<ge> (k + c0) powr (1+\<epsilon>)"
        using ab_k[OF that]
        apply (subst (asm) powr_less_eq_inverse_iff')
        using \<open>\<epsilon> >0\<close> by auto
      then have "inverse (aa k / bb k) \<le> inverse ((k + c0) powr (1+\<epsilon>))"
        apply (elim le_imp_inverse_le)
        using \<open>k + c0 >0\<close> by auto
      then show ?thesis by (simp add: inverse_eq_divide)
    qed
    ultimately show ?thesis
      apply (elim summable_comparison_test'[where N=t])
      using aa_bb_pos by (simp add: less_eq_real_def)
  qed

  have 7:"\<exists>\<^sub>\<infinity> k. 1 / (M powr (\<epsilon>/(1+\<epsilon>)) * (\<Prod>i = 0..k. aa i)
                  powr(2+ \<delta> * \<epsilon> / (1+\<epsilon>))) > (bb (k+1) / aa(k+1)) powr (\<epsilon> / (1+\<epsilon>))"
      when "M > 0" for M
  proof -
    define tt where "tt= (\<lambda>i. prod aa {0..i} powr (2 + 2 / \<epsilon> + \<delta>))"
    have tt_pos:"tt i > 0" for i
      unfolding tt_def
      apply(subst powr_gt_zero,induct i)
      subgoal by (metis aa_bb_pos(1) order_less_irrefl prod_pos)
      subgoal by (metis \<open>\<And>k. 0 < aa k\<close> order_less_irrefl prod_pos)
      done
    have "\<exists>\<^sub>\<infinity>i. M < (aa (i + 1) / tt i * (1 / bb (i + 1)))"
      using limsup_infinity_imp_Inf_many[OF limsup_infi,rule_format,of M]
      unfolding tt_def by auto
    then have "\<exists>\<^sub>\<infinity>i. 1 / (M * tt i) > (bb (i+1) / aa (i+1))"
      apply (elim INFM_mono)
      using \<open>M>0\<close> tt_pos by (auto simp:divide_simps algebra_simps)
    then have "\<exists>\<^sub>\<infinity>i. (1 / (M * tt i)) powr (\<epsilon>/(1+\<epsilon>))
                        > (bb (i+1) / aa (i+1)) powr (\<epsilon>/(1+\<epsilon>))"
      apply (elim INFM_mono powr_less_mono2[rotated 2])
      by (simp_all add: assms(6) pos_add_strict less_eq_real_def)
    moreover have "tt i  powr (\<epsilon>/(1+\<epsilon>)) = prod aa {0..i} powr (2 + \<delta> * \<epsilon> / (1+\<epsilon>))"
        for i
      unfolding tt_def
      apply (auto simp:powr_powr)
      using \<open>\<epsilon>>0\<close> by (simp add:divide_simps,simp add:algebra_simps)
    ultimately show ?thesis
      apply (elim INFM_mono)
      by (smt nonzero_mult_div_cancel_left powr_divide powr_mult powr_one_eq_one
                that tt_pos zero_less_divide_iff)
  qed

  have 8:"\<forall>\<^sub>F k in sequentially. \<forall>s.  (( aa(k+s)/bb( k+s))) \<ge>
                    ((( aa k/bb k) powr(1/(1+\<epsilon>))) +s)powr(1+\<epsilon>)"
    using eventually_ge_at_top[of t]
  proof eventually_elim
    case (elim k)
    define ff where "ff=(\<lambda>k. (aa k / bb k) powr (1 / (1 + \<epsilon>)))"
    have 11:"ff k+s \<le> ff (k+s)" for s
    proof (induct s)
      case 0
      then show ?case unfolding ff_def by auto
    next
      case (Suc s)
      then have "ff k + Suc s \<le> ff (k+Suc s)"
        using ratio_large[rule_format,of "k+s"] \<open> t \<le> k\<close> unfolding ff_def by auto
      then show ?case by simp
    qed
    then have "(ff k+s) powr (1+\<epsilon>) \<le> ff (k+s) powr (1+\<epsilon>)" for s
      apply (rule powr_mono2[of "1+\<epsilon>",rotated 2])
      unfolding ff_def using \<open>\<epsilon>>0\<close> by auto
    then show ?case unfolding ff_def using \<open>\<epsilon>>0\<close>
      apply (auto simp add:powr_powr)
      by (simp add: a_pos aa_def b_pos bb_def le_less)
  qed

  have 9: "(\<Sum>r. 1/((z+real r)powr(1+\<epsilon>))) \<le> 1/(\<epsilon> *(z-1) powr \<epsilon>)"
      "summable (\<lambda>i. 1/((z+ real i)powr(1+\<epsilon>)))"
    when "z>1" for z
  proof -
    define f where "f= (\<lambda>r. 1/((z+ r)powr(1+\<epsilon>)))"
    have "((\<lambda>x. f (x - 1)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0..}"
    proof -
       have "((\<lambda>x. (z-1 + x) powr (- 1 - \<epsilon>)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0<..}"
        using powr_has_integral_at_top[of 0 "z-1" "- 1 - \<epsilon>",simplified] \<open>z>1\<close> \<open>\<epsilon>>0\<close>
        by auto
      then have "((\<lambda>x. (z-1 + x) powr (- 1 - \<epsilon>)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0..}"
        apply (subst (asm) has_integral_closure[symmetric])
        by (auto simp add: negligible_convex_frontier)
      then show ?thesis
        apply (rule has_integral_cong[THEN iffD1, rotated 1])
        unfolding f_def by (smt powr_minus_divide)
    qed
    moreover have "\<And>x. 0 \<le> x \<Longrightarrow> 0 \<le> f (x - 1)" unfolding f_def by simp
    moreover have "\<And>x y. 0 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> f (y - 1) \<le> f (x - 1)" unfolding f_def
      by (smt assms(6) frac_le powr_mono2 powr_nonneg_iff that)
    ultimately have "summable (\<lambda>i. f (real i))" "(\<Sum>i. f (real i)) \<le> (z - 1) powr - \<epsilon> / \<epsilon>"
      using decreasing_sum_le_integral[of "\<lambda>x. f (x-1)" "((z-1) powr - \<epsilon>) / \<epsilon>",simplified]
      by auto
    moreover have "(z - 1) powr - \<epsilon> / \<epsilon> = 1/(\<epsilon> *(z-1) powr \<epsilon>)"
      by (simp add: powr_minus_divide)
    ultimately show "(\<Sum>i. f (real i)) \<le> 1/(\<epsilon> *(z-1) powr \<epsilon>)" by auto
    show "summable (\<lambda>i. f (real i))" using \<open>summable (\<lambda>i. f (real i))\<close> .
  qed

  have u:"(\<lambda>k.( aa k / bb k)) \<longlonglongrightarrow> \<infinity>"
  proof -
    define ff where "ff\<equiv>(\<lambda>x. ereal (aa x / bb x))"
    have "limsup ff =  \<infinity>"
    proof -
      define tt where "tt= (\<lambda>i. prod aa {0..i} powr (2 + 2 / \<epsilon> + \<delta>))"
      have "tt i \<ge> 1" for i
        unfolding tt_def
        apply (rule ge_one_powr_ge_zero)
        subgoal
          apply (rule linordered_nonzero_semiring_class.prod_ge_1)
          by (simp add: a_pos aa_def int_one_le_iff_zero_less)
        subgoal by (simp add: \<open>\<epsilon>>0\<close> \<open>\<delta>>0\<close> less_imp_le)
        done
      then have "limsup (\<lambda>x.  (aa (x + 1) / tt x * (1 / bb (x + 1))))
                  \<le> limsup (\<lambda>x.  aa (x + 1) / bb (x + 1))"
        apply (intro Limsup_mono eventuallyI)
        apply (auto simp add:field_simps order.order_iff_strict)
        by (metis aa_bb_pos(1) div_by_1 frac_less2 less_irrefl less_numeral_extra(1)
            not_le)
      also have "... = limsup (\<lambda>x.  aa x / bb x)"
        by (subst limsup_shift,simp)
      finally have "limsup (\<lambda>x. ereal (aa (x + 1) / tt x * (1 / bb (x + 1))))
                      \<le> limsup (\<lambda>x. ereal (aa x / bb x))" .
      moreover have "limsup (\<lambda>x. ereal (aa (x + 1) / tt x * (1 / bb (x + 1))))
                        = \<infinity>" using limsup_infi unfolding tt_def by auto
      ultimately show ?thesis
        unfolding ff_def using ereal_infty_less_eq2(1) by blast
    qed
    then have "limsup (\<lambda>k. ff (k+t)) =  \<infinity>"
      by (simp add: limsup_shift_k)
    moreover have "incseq (\<lambda>k. ff (k+t))"
    proof (rule incseq_SucI)
      fix k::nat
      define gg where "gg\<equiv>(\<lambda>x. (aa x / bb x))"
      have "(gg (k+t)) powr (1 / (1 + \<epsilon>)) + 1
                \<le> (gg (Suc (k+t))) powr (1 / (1 + \<epsilon>))"
        using ratio_large[rule_format, of "k+t",simplified] unfolding gg_def
        by auto
      then have "(gg (k+t)) powr (1 / (1 + \<epsilon>))
                      \<le> (gg (Suc (k+t))) powr (1 / (1 + \<epsilon>))"
        by auto
      then have "gg (k+t)\<le> gg (Suc (k+t))"
        by (smt aa_bb_pos(1) aa_bb_pos(2) assms(6) divide_pos_pos gg_def
                powr_less_mono2)
      then show "ff (k + t) \<le> ff (Suc k + t)"
        unfolding gg_def ff_def by auto
    qed
    ultimately have "(\<lambda>k. ff (k+t)) \<longlonglongrightarrow> \<infinity>" using incseq_tendsto_limsup
      by fastforce
    then show ?thesis unfolding ff_def
      unfolding tendsto_def
      apply (subst eventually_sequentially_seg[symmetric,of _ t])
      by simp
  qed

  define \<xi> where "\<xi> = suminf (\<lambda> k. bb k / aa k)"
  have 10:"\<forall>\<^sub>F k in sequentially. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>
                        < 2 / \<epsilon> * (bb (k+1) / aa (k+1)) powr (\<epsilon> / (1+\<epsilon>))"
    using 8[THEN sequentially_offset,of 1] eventually_ge_at_top[of t]
            u[unfolded tendsto_PInfty,rule_format,THEN sequentially_offset
                        ,of "(2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1)) powr (1+\<epsilon>)" 1]
  proof eventually_elim
    case (elim k)
    define tt where "tt=(aa (k + 1) / bb (k + 1)) powr (1 / (1 + \<epsilon>))"
    have "tt>1"
    proof -
      have "(aa k / bb k) powr (1 / (1 + \<epsilon>)) > 0"
        by (metis a_pos aa_def b_pos bb_def divide_eq_0_iff less_irrefl
                of_int_eq_0_iff powr_gt_zero)
      then show ?thesis using ratio_large[rule_format,OF \<open>k\<ge>t\<close>] unfolding tt_def by argo
    qed
    have "\<bar>\<xi> - (\<Sum>i = 0..k. bb i / aa i)\<bar> = \<bar>\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))\<bar>"
      unfolding \<xi>_def
      apply (subst suminf_minus_initial_segment[of _ "k+1",OF summable])
      using atLeast0AtMost lessThan_Suc_atMost by auto
    also have "... = (\<Sum>i. bb (i+(k+1)) / aa (i+(k+1)))"
    proof -
      have "(\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))) > 0"
        apply (rule suminf_pos)
        subgoal using summable[THEN summable_ignore_initial_segment,of "k+1"] .
        subgoal by (simp add: a_pos aa_def b_pos bb_def)
        done
      then show ?thesis by auto
    qed
    also have "... \<le> (\<Sum>i. 1 / (tt + i) powr (1 + \<epsilon>))"
    proof (rule suminf_le)
      define ff where "ff=(\<lambda>k n. (aa (k+1) / bb (k+1)) powr (1 / (1 + \<epsilon>)) + real n)"
      have "bb (n + (k + 1)) / aa (n + (k + 1)) \<le> 1 / (ff k n) powr (1 + \<epsilon>)" for n
      proof -
        have "ff k n powr (1 + \<epsilon>) \<le> aa (k + n +1 ) / bb (k + n+1 )"
          using elim(1)[rule_format,of n] unfolding ff_def by auto
        moreover have "ff k n powr (1 + \<epsilon>) > 0"
          unfolding ff_def by (smt elim(2) of_nat_0_le_iff powr_gt_zero ratio_large)
        ultimately have "1 / ff k n powr (1 + \<epsilon>) \<ge>  bb (k + (n + 1)) / aa (k + (n + 1))"
          apply (drule_tac le_imp_inverse_le)
          by (auto simp add: inverse_eq_divide)
        then show ?thesis by (auto simp:algebra_simps)
      qed
      then show " \<forall>n. bb (n + (k + 1)) / aa (n + (k + 1)) \<le> 1 / (tt + real n) powr (1 + \<epsilon>)"
        unfolding ff_def tt_def by auto
      show "summable (\<lambda>i. bb (i + (k + 1)) / aa (i + (k + 1)))"
        using summable[THEN summable_ignore_initial_segment,of "k+1"] .
      show "summable (\<lambda>x. 1 / (tt + real x) powr (1 + \<epsilon>))"
        using 9(2)[OF \<open>tt>1\<close>] .
    qed
    also have "... \<le> 1/(\<epsilon> *(tt-1) powr \<epsilon>)"
      using 9[OF \<open>tt>1\<close>] by simp
    also have "... < 2 / (\<epsilon> *tt powr \<epsilon>)"
    proof -
      have "((2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1)) powr (1 + \<epsilon>)) < (aa (k+1) / bb (k+1))"
        using elim(3) by auto
      then have "2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1) < tt"
        unfolding tt_def
        apply (drule_tac powr_less_mono2[rotated 2,where a="1/ (1 + \<epsilon>)"])
        using \<open>\<epsilon>>0\<close> apply (auto simp:powr_powr )
        by (subst (asm) powr_one,auto simp add:field_simps)
      then have " tt < (tt-1) * (2 powr (1/\<epsilon>))"
        using \<open>\<epsilon>>0\<close> by (auto simp:divide_simps algebra_simps)
      then have "tt powr \<epsilon> < 2 * (tt - 1) powr \<epsilon>"
        apply (drule_tac powr_less_mono2[rotated 2,where a="\<epsilon>"])
        using \<open>\<epsilon>>0\<close> \<open>tt>1\<close> by (auto simp:powr_powr powr_mult)
      then show ?thesis
        using \<open>\<epsilon>>0\<close> \<open>tt>1\<close> by (auto simp:divide_simps)
    qed
    also have "... =  2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
      unfolding tt_def
      using \<open>\<epsilon>>0\<close>
      by (auto simp:powr_powr divide_simps algebra_simps powr_divide less_imp_le)
    finally show ?case .
  qed

  define pq where "pq = (\<lambda>k. quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)))"
  define p q where "p = fst \<circ> pq" and "q = snd \<circ> pq"
  have coprime_pq:"coprime (p k) (q k)"
        and q_pos:"q k > 0" and pq_sum:"p k / q k = (\<Sum>i=0..k. b i / a i)" for k
  proof -
    have eq: "quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)) = (p k, q k)"
      by (simp add: p_def q_def pq_def)
    from quotient_of_coprime[OF eq] show "coprime (p k) (q k)" .
    from quotient_of_denom_pos[OF eq] show "q k > 0" .
    have "(\<Sum>i=0..k. b i / a i) = of_rat (\<Sum>i=0..k. of_int (b i) / of_int (a i))"
      by (simp add: of_rat_sum of_rat_divide)
    also have "(\<Sum>i=0..k. rat_of_int (b i) / rat_of_int (a i)) =
                 rat_of_int (p k) / rat_of_int (q k)"
      using quotient_of_div[OF eq] by simp
    finally show "p k / q k = (\<Sum>i=0..k. b i / a i)" by (simp add:of_rat_divide)
  qed

  have \<xi>_Inf_many:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar> <  1 / q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
  proof -
    have *:"\<exists>\<^sub>\<infinity>k. (bb (Suc k) / aa (Suc k)) powr (\<epsilon> / (1 + \<epsilon>))
              < \<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)))"
      using 7[of "(2 / \<epsilon>) powr ((1+\<epsilon>)/ \<epsilon>)"] \<open>\<epsilon>>0\<close>
      by (auto simp:powr_powr)
    have **:"\<forall>\<^sub>\<infinity>k. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>
                < 2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
      using 10[unfolded cofinite_eq_sequentially[symmetric]] .
    from INFM_conjI[OF * **] show ?thesis
    proof (elim INFM_mono)
      fix k assume asm:"(bb (Suc k) / aa (Suc k)) powr (\<epsilon> / (1 + \<epsilon>))
                         < \<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))) \<and>
                          \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>
                        < 2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
      have "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar>
              = \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>"
        using pq_sum unfolding aa_def bb_def by auto
      also have "... < (2 / \<epsilon>) * (bb (k+1) / aa (k+1)) powr (\<epsilon> / (1+\<epsilon>))"
        using asm by auto
      also have "... <  (2 / \<epsilon>) * (\<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))))"
        apply (rule mult_strict_left_mono)
        using asm \<open>\<epsilon>>0\<close> by auto
      also have "... = 1/ prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
        using \<open>\<epsilon>>0\<close> by auto
      also have "... \<le> 1 / q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
      proof -
        have "q k \<le> prod aa {0..k}"
        proof (induct k)
          case 0
          then show ?case unfolding q_def pq_def aa_def
            apply (simp add:rat_divide_code of_int_rat quotient_of_Fract)
            using aa_bb_pos[of 0,unfolded aa_def bb_def] unfolding Let_def normalize_def
            apply auto
            by (metis div_by_1 less_imp_le less_trans nonneg1_imp_zdiv_pos_iff
                not_less zdiv_mono2)
        next
          case (Suc k)
          define de where "de=snd \<circ> quotient_of"
          have "real_of_int (q (Suc k))
                  = de (\<Sum>i=0..Suc k. of_int (b i) / of_int (a i))"
            unfolding q_def pq_def de_def by simp
          also have "... = de ((\<Sum>i=0..k. of_int (b i) / of_int (a i))
                                + of_int (b (Suc k)) / of_int (a (Suc k)))"
            by simp
          also have "... \<le> de (\<Sum>i=0..k. of_int (b i) / of_int (a i))
                                * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
            using snd_quotient_plus_leq[folded de_def] by presburger
          also have "... = q k * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
            unfolding q_def pq_def de_def by auto
          also have "... = q k * snd (Rat.normalize (b (Suc k), a (Suc k)))"
            by (simp add:rat_divide_code of_int_rat quotient_of_Fract de_def)
          also have "... \<le> q k * aa (Suc k)"
            using aa_bb_pos[of "Suc k"] q_pos[of "k"]
            unfolding normalize_def aa_def bb_def Let_def
            apply auto
            by (metis div_by_1 int_one_le_iff_zero_less less_trans
                  nonneg1_imp_zdiv_pos_iff not_less zdiv_mono2 zero_less_one)
          also have "... \<le>  prod aa {0..k} * aa (Suc k)"
            using Suc aa_bb_pos[of "Suc k"] by auto
          also have "... = prod aa {0..Suc k}"
            by (simp add: prod.atLeast0_atMost_Suc)
          finally show ?case .
        qed
        then show ?thesis
          apply (rule_tac divide_left_mono)
          apply (rule powr_mono2)
          using \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> q_pos[of k]
           apply (auto simp:powr_mult[symmetric])
          by (metis aa_bb_pos(1) less_irrefl)
      qed
      finally show "\<bar>\<xi> -  p k / q k\<bar> < 1 /  q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
    qed
  qed

  define pqs where "pqs={(p, q). q>0 \<and> coprime p q \<and> \<bar>\<xi> - real_of_int p / real_of_int q\<bar>
                  < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))}"
  have \<xi>_infinite:"infinite pqs"
  proof -
    define A where "A={k. \<bar>\<xi> -  (p k) /  (q k)\<bar> < 1 / (q k) powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))}"
    note \<xi>_Inf_many
    then have "infinite A"
      unfolding Inf_many_def A_def by auto
    moreover have "inj_on (\<lambda>k. (p k, q k)) A"
    proof -
      define g where "g=(\<lambda>i. rat_of_int (b i) / rat_of_int (a i))"
      define f where "f=(\<lambda>k. \<Sum>i = 0..k. g i)"
      have g_pos:"g i>0" for i
        unfolding g_def by (simp add: a_pos b_pos)
      have "strict_mono f" unfolding strict_mono_def f_def
      proof safe
        fix x y::nat assume "x < y"
        then have "sum g {0..y} - sum g {0..x} = sum g {x<..y}"
          apply (subst  Groups_Big.sum_diff[symmetric])
          by (auto intro:arg_cong2[where f=sum])
        also have "... > 0"
          apply (rule ordered_comm_monoid_add_class.sum_pos)
          using \<open>x<y\<close> g_pos by auto
        finally have "sum g {0..y} - sum g {0..x} >0" .
        then show "sum g {0..x} < sum g {0..y}" by auto
      qed
      then have "inj f" using strict_mono_imp_inj_on by auto
      then have "inj (quotient_of o f)" by (simp add: inj_compose quotient_of_inj)
      then have "inj (\<lambda>k. (p k, q k))"
        unfolding f_def p_def q_def pq_def comp_def
        apply (fold g_def)
        by auto
      then show ?thesis by (auto elim:subset_inj_on)
    qed
    moreover have "(\<lambda>k. (p k, q k)) ` A \<subseteq> pqs"
      unfolding A_def pqs_def using coprime_pq q_pos by auto
    ultimately show ?thesis
      apply (elim infinite_inj_imageE)
      by auto
  qed
  moreover have "finite pqs" if "\<xi> \<in> \<rat>"
  proof -
    obtain m n where \<xi>_mn:"\<xi> = (of_int m / of_int n)" and "coprime m n" "n>0"
    proof -
      obtain m n where mn:"\<bar>\<xi>\<bar> = (of_nat m / of_nat n)" "coprime m n" "n\<noteq>0"
        using Rats_abs_nat_div_natE[OF \<open>\<xi> \<in> \<rat>\<close> Rats_abs_nat_div_natE]
        by metis
      define m' and n'::int
        where "m'=(if \<xi> > 0 then nat m else -nat m)" and "n'=nat n"
      then have "\<xi> = (of_int m' / of_int n')" "coprime m' n'" "n'>0"
        using mn by auto
      then show ?thesis using that by auto
    qed
    have "pqs \<subseteq> {(m,n)} \<union> {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
    proof (rule subsetI)
      fix x assume "x \<in> pqs"
      define p q where "p=fst x" and "q=snd x"
      have "q>0" "coprime p q" and pq_less:"\<bar>\<xi> - p / q\<bar>
          < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
        using \<open>x\<in>pqs\<close> unfolding p_def q_def pqs_def by auto
      have q_lt_n:"q<n" when "m\<noteq>p \<or> n\<noteq>q"
      proof -
        have "m * q \<noteq> n * p" using that \<open>coprime m n\<close> \<open>coprime p q\<close> \<open>q>0\<close> \<open>n>0\<close>
          by (metis eq_rat(1) fst_conv int_one_le_iff_zero_less mult.commute normalize_stable
                not_one_le_zero quotient_of_Fract snd_conv)
        then have "1/(n*q) \<le> \<bar>m/n - p/q\<bar>"
          using \<open>q>0\<close> \<open>n>0\<close>
          apply (auto simp:field_simps)
          by (metis add_diff_cancel_left' diff_diff_eq2 diff_zero less_irrefl not_le of_int_diff
                of_int_lessD of_int_mult)
        also have "...  < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
          using pq_less unfolding \<xi>_mn by auto
        also have "... \<le> 1 / q ^2"
        proof -
          have "real_of_int (q\<^sup>2) = q powr 2"
            apply (subst powr_numeral)
            unfolding power2_eq_square using \<open>q>0\<close> by auto
          also have "... \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
            apply (rule powr_mono)
            using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
          finally have "real_of_int (q\<^sup>2)
                          \<le> real_of_int q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
          moreover have "real_of_int q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) > 0" using \<open>0 < q\<close> by auto
          ultimately show ?thesis by (auto simp:field_simps)
        qed
        finally have " 1 /  (n * q) < 1 / q\<^sup>2" .
        then show ?thesis  using \<open>q>0\<close> \<open>n>0\<close>
          unfolding power2_eq_square by (auto simp:field_simps)
      qed
      moreover have "- \<bar>m\<bar> - 1 \<le> p \<and> p \<le> \<bar>m\<bar> + 1" when "m\<noteq>p \<or> n\<noteq>q"
      proof -
        define qn where "qn=q/n"
        have "0<qn" "qn<1" unfolding qn_def using q_lt_n[OF \<open>m\<noteq>p \<or> n\<noteq>q\<close>] \<open>q>0\<close> by auto

        have "\<bar>m/n - p / q\<bar> < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
          using pq_less unfolding \<xi>_mn by simp
        then have "\<bar>p / q - m/n\<bar> < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" by simp
        then have " m/n- 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))
            < p/q \<and> p/q < m/n + 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
          unfolding abs_diff_less_iff by auto
        then have "qn*m- q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) < p
            \<and> p < qn*m + q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
          unfolding qn_def using \<open>q>0\<close> by (auto simp:field_simps)
        moreover have "- \<bar>m\<bar> - 1 \<le> qn*m- q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
        proof -
          have "- \<bar>m\<bar> \<le> qn*m" using \<open>0<qn\<close> \<open>qn<1\<close>
            apply (cases "m\<ge>0")
            subgoal
              apply simp
              by (meson less_eq_real_def mult_nonneg_nonneg neg_le_0_iff_le of_int_0_le_iff
                          order_trans)
            subgoal by simp
            done
          moreover have "- 1 \<le> - q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
          proof -
            have "q = q powr 1" using \<open>0 < q\<close> by auto
            also have "... \<le>q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
              apply (rule powr_mono)
              using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
            finally have "q \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
            then show ?thesis using \<open>0 < q\<close> by auto
          qed
          ultimately show ?thesis by auto
        qed
        moreover have "qn*m + q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) \<le> \<bar>m\<bar> + 1"
        proof -
          have "qn*m \<le> \<bar>m\<bar>" using \<open>0<qn\<close> \<open>qn<1\<close>
            apply (cases "m\<ge>0")
            subgoal by (simp add: mult_left_le_one_le)
            subgoal by (smt of_int_0_le_iff zero_le_mult_iff)
            done
          moreover have "q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) \<le> 1"
          proof -
            have "q = q powr 1" using \<open>0 < q\<close> by auto
            also have "... \<le>q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
              apply (rule powr_mono)
              using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
            finally have "q \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
            then show ?thesis using \<open>0 < q\<close> by auto
          qed
          ultimately show ?thesis by auto
        qed
        ultimately show ?thesis by auto
      qed
      ultimately show "x \<in> {(m, n)} \<union> {x \<in> pqs. - \<bar>m\<bar> - 1 \<le> fst x \<and> fst x \<le> \<bar>m\<bar> + 1
                          \<and> 0 < snd x \<and> snd x < n}"
        using \<open>x \<in> pqs\<close> \<open>q>0\<close> unfolding p_def q_def by force
    qed
    moreover have "finite {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
    proof -
      have "finite ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})" by blast
      moreover have "{x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n } \<subseteq>
                ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})"
        by auto
      ultimately show ?thesis
        apply (elim rev_finite_subset)
        by blast
    qed
    ultimately show ?thesis using finite_subset by auto
  qed
  ultimately show ?thesis
    apply (fold \<xi>_def)
    using RothsTheorem[rule_format,of \<xi> "2 + \<delta> * \<epsilon> / (1 + \<epsilon>)",folded pqs_def]
      \<open>\<delta> >0\<close> \<open>\<epsilon>>0\<close>
    apply (auto simp:divide_simps )
    by (meson mult_le_0_iff not_less)
qed

subsection\<open> Acknowledgements\<close>

text\<open>A.K.-A. and W.L. were supported by the ERC Advanced Grant ALEXANDRIA (Project 742178)
 funded by the European Research Council and led by Professor Lawrence Paulson
 at the University of Cambridge, UK. Thanks to Iosif Pinelis for his clarification on
MathOverflow regarding the summmability of the series in @{thm [source] RothsTheorem.HanclRucki2}
@{url "https://mathoverflow.net/questions/323069/why-is-this-series-summable"}
and to Manuel Eberl for his helpful comments.\<close>

end


(*   Title: HOL/ex/Erdős_Szekeres.thy
     Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com>
*)

section \<open>The Erdös-Szekeres Theorem\<close>

theory Erdoes_Szekeres
imports Main
begin

lemma exists_set_with_max_card:
  assumes "finite S" "S \<noteq> {}"
  shows "\<exists>s \<in> S. card s = Max (card ` S)"
  by (metis (mono_tags, lifting) Max_in assms finite_imageI imageE image_is_empty)

subsection \<open>Definition of Monotonicity over a Carrier Set\<close>

definition
  "gen_mono_on f R S = (\<forall>i\<in>S. \<forall>j\<in>S. i \<le> j \<longrightarrow> R (f i) (f j))"

lemma gen_mono_on_empty [simp]: "gen_mono_on f R {}"
  unfolding gen_mono_on_def by auto

lemma gen_mono_on_singleton [simp]: "reflp R \<Longrightarrow> gen_mono_on f R {x}"
  unfolding gen_mono_on_def reflp_def by auto

lemma gen_mono_on_subset: "T \<subseteq> S \<Longrightarrow> gen_mono_on f R S \<Longrightarrow> gen_mono_on f R T"
  unfolding gen_mono_on_def by (simp add: subset_iff)

lemma not_gen_mono_on_subset: "T \<subseteq> S \<Longrightarrow> \<not> gen_mono_on f R T \<Longrightarrow> \<not> gen_mono_on f R S"
  unfolding gen_mono_on_def by blast

subsection \<open>The Erdoes-Szekeres Theorem following Seidenberg's (1959) argument\<close>

lemma Erdoes_Szekeres:
  fixes f :: "_ \<Rightarrow> 'a::linorder"
  shows "(\<exists>S. S \<subseteq> {0..m * n} \<and> card S = m + 1 \<and> gen_mono_on f (\<le>) S) \<or>
         (\<exists>S. S \<subseteq> {0..m * n} \<and> card S = n + 1 \<and> gen_mono_on f (\<ge>) S)"
proof (rule ccontr)
  let ?max_subseq = "\<lambda>R k. Max (card ` {S. S \<subseteq> {0..k} \<and> gen_mono_on f R S \<and> k \<in> S})"
  define phi where "phi k = (?max_subseq (\<le>) k, ?max_subseq (\<ge>) k)" for k

  have one_member: "\<And>R k. reflp R \<Longrightarrow> {k} \<in> {S. S \<subseteq> {0..k} \<and> gen_mono_on f R S \<and> k \<in> S}" by auto

  {
    fix R
    assume reflp: "reflp (R :: 'a::linorder \<Rightarrow> _)"
    from one_member[OF this] have non_empty: "\<And>k. {S. S \<subseteq> {0..k} \<and> gen_mono_on f R S \<and> k \<in> S} \<noteq> {}" by force
    from one_member[OF reflp] have "\<And>k. card {k} \<in> card ` {S. S \<subseteq> {0..k} \<and> gen_mono_on f R S \<and> k \<in> S}" by blast
    from this have lower_bound: "\<And>k. k \<le> m * n \<Longrightarrow> ?max_subseq R k \<ge> 1"
      by (auto intro!: Max_ge)

    fix b
    assume not_mono_at: "\<forall>S. S \<subseteq> {0..m * n} \<and> card S = b + 1 \<longrightarrow> \<not> gen_mono_on f R S"

    {
      fix S
      assume "S \<subseteq> {0..m * n}" "card S \<ge> b + 1"
      moreover from \<open>card S \<ge> b + 1\<close> obtain T where "T \<subseteq> S \<and> card T = Suc b"
        using obtain_subset_with_card_n by (metis Suc_eq_plus1)
      ultimately have "\<not> gen_mono_on f R S" using not_mono_at by (auto dest: not_gen_mono_on_subset)
    }
    from this have "\<forall>S. S \<subseteq> {0..m * n} \<and> gen_mono_on f R S \<longrightarrow> card S \<le> b"
      by (metis Suc_eq_plus1 Suc_leI not_le)
    from this have "\<And>k. k \<le> m * n \<Longrightarrow> \<forall>S. S \<subseteq> {0..k} \<and> gen_mono_on f R S \<longrightarrow> card S \<le> b"
      using order_trans by force
    from this non_empty have upper_bound: "\<And>k. k \<le> m * n \<Longrightarrow> ?max_subseq R k \<le> b"
      by (auto intro: Max.boundedI)

    from upper_bound lower_bound have "\<And>k. k \<le> m * n \<Longrightarrow> 1 \<le> ?max_subseq R k \<and> ?max_subseq R k \<le> b"
      by auto
  } note bounds = this

  assume contraposition: "\<not> ?thesis"
  from contraposition bounds[of "(\<le>)" "m"] bounds[of "(\<ge>)" "n"]
    have "\<And>k. k \<le> m * n \<Longrightarrow> 1 \<le> ?max_subseq (\<le>) k \<and> ?max_subseq (\<le>) k \<le> m"
    and  "\<And>k. k \<le> m * n \<Longrightarrow> 1 \<le> ?max_subseq (\<ge>) k \<and> ?max_subseq (\<ge>) k \<le> n"
    using reflp_def by simp+
  from this have "\<forall>i \<in> {0..m * n}. phi i \<in> {1..m} \<times> {1..n}"
    unfolding phi_def by auto
  from this have subseteq: "phi ` {0..m * n} \<subseteq> {1..m} \<times> {1..n}" by blast
  have card_product: "card ({1..m} \<times> {1..n}) = m * n" by (simp add: card_cartesian_product)
  have "finite ({1..m} \<times> {1..n})" by blast
  from subseteq card_product this have card_le: "card (phi ` {0..m * n}) \<le> m * n" by (metis card_mono)

  {
    fix i j
    assume "i < (j :: nat)"
    {
      fix R
      assume R: "reflp (R :: 'a::linorder \<Rightarrow> _)" "transp R" "R (f i) (f j)"
      from one_member[OF \<open>reflp R\<close>, of "i"] have
        "\<exists>S \<in> {S. S \<subseteq> {0..i} \<and> gen_mono_on f R S \<and> i \<in> S}. card S = ?max_subseq R i"
        by (intro exists_set_with_max_card) auto
      from this obtain S where S: "S \<subseteq> {0..i} \<and> gen_mono_on f R S \<and> i \<in> S" "card S = ?max_subseq R i" by auto
      from S \<open>i < j\<close> finite_subset have "j \<notin> S" "finite S" "insert j S \<subseteq> {0..j}" by auto
      from S(1) R \<open>i < j\<close> this have "gen_mono_on f R (insert j S)"
        unfolding gen_mono_on_def reflp_def transp_def
        by (metis atLeastAtMost_iff insert_iff le_antisym subsetCE)
      from this have d: "insert j S \<in> {S. S \<subseteq> {0..j} \<and> gen_mono_on f R S \<and> j \<in> S}"
        using \<open>insert j S \<subseteq> {0..j}\<close> by blast
      from this \<open>j \<notin> S\<close> S(1) have "card (insert j S) \<in>
        card ` {S. S \<subseteq> {0..j} \<and> gen_mono_on f R S \<and> j \<in> S} \<and> card S < card (insert j S)"
        by (auto intro!: imageI) (auto simp add: \<open>finite S\<close>)
      from this S(2) have "?max_subseq R i < ?max_subseq R j" by (auto intro!: Max_gr_iff [THEN iffD2])
    } note max_subseq_increase = this
    have "?max_subseq (\<le>) i < ?max_subseq (\<le>) j \<or> ?max_subseq (\<ge>) i < ?max_subseq (\<ge>) j"
    proof (cases "f j \<ge> f i")
      case True
      from this max_subseq_increase[of "(\<le>)", simplified] show ?thesis by simp
    next
      case False
      from this max_subseq_increase[of "(\<ge>)", simplified] show ?thesis by simp
    qed
    from this have "phi i \<noteq> phi j" using phi_def by auto
  }
  from this have "inj phi" unfolding inj_on_def by (metis less_linear)
  from this have card_eq: "card (phi ` {0..m * n}) = m * n + 1" by (simp add: card_image inj_on_def)
  from card_le card_eq show False by simp
qed

end