section \<open>Number theory problems\<close>

subsection \<open>IMO 2018 SL - N5\<close>

theory IMO_2018_SL_N5_sol
imports Main
begin

definition perfect_square :: "int \<Rightarrow> bool" where
  "perfect_square s \<longleftrightarrow> (\<exists> r. s = r * r)"

lemma perfect_square_root_pos:
  assumes "perfect_square s"
  shows "\<exists> r. r \<ge> 0 \<and> s = r * r"
  using assms
  unfolding perfect_square_def
  by (smt mult_minus_left mult_minus_right)

lemma not_perfect_square_15:
  fixes q::int
  shows "q^2 \<noteq> 15"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "3^2 < (abs q)^2" "(abs q)^2 < 4^2"
    by auto
  then have "3 < abs q" "abs q < 4"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma not_perfect_square_12:
  fixes q::int
  shows "q^2 \<noteq> 12"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "3^2 < (abs q)^2" "(abs q)^2 < 4^2"
    by auto
  then have "3 < abs q" "abs q < 4"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma not_perfect_square_8:
  fixes q::int
  shows "q^2 \<noteq> 8"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "2^2 < (abs q)^2" "(abs q)^2 < 3^2"
    by auto
  then have "2 < abs q" "abs q < 3"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma not_perfect_square_7:
  fixes q::int
  shows "q^2 \<noteq> 7"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "2^2 < (abs q)^2" "(abs q)^2 < 3^2"
    by auto
  then have "2 < abs q" "abs q < 3"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma not_perfect_square_5:
  fixes q::int
  shows "q^2 \<noteq> 5"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "2^2 < (abs q)^2" "(abs q)^2 < 3^2"
    by auto
  then have "2 < abs q" "abs q < 3"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma not_perfect_square_3:
  fixes q::int
  shows "q^2 \<noteq> 3"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "1^2 < (abs q)^2" "(abs q)^2 < 2^2"
    by auto
  then have "1 < abs q" "abs q < 2"
    using abs_ge_zero power_less_imp_less_base zero_le_numeral
    by blast+
  then show False
    by simp
qed

lemma IMO2018SL_N5_lemma:
  fixes s a b c d :: int
  assumes "s^2 = a^2 + b^2" "s^2 = c^2 + d^2" "2*s = a^2 - c^2"
  assumes  "s > 0" "a \<ge> 0" "d \<ge> 0" "b \<ge> 0" "c \<ge> 0" "b > 0 \<or> c > 0" "b \<ge> c"
  shows False
proof-
  have "2*s = d^2 - b^2"
    using assms
    by simp

  have "d > 0"
    using \<open>2 * s = d^2 - b^2\<close> \<open>s > 0\<close> \<open>d \<ge> 0\<close>
    by (smt pos_imp_zdiv_neg_iff zero_less_power2)

  have "a > 0"
    using \<open>2 * s = a^2 - c^2\<close> \<open>s > 0\<close> \<open>a \<ge> 0\<close>
    by (smt pos_imp_zdiv_neg_iff zero_less_power2)

  have "b > 0"
    using assms
    by auto

  have "d^2 > c^2"
    using \<open>2 * s = d\<^sup>2 - b\<^sup>2\<close> \<open>c \<le> b\<close> \<open>0 < s\<close>  \<open>c \<ge> 0\<close>
    by (smt power_mono)

  then have "d^2 > s^2 div 2"
    using \<open>s^2 = c^2 + d^2\<close>
    by presburger

  then have "2*s^2 < 4*d^2"
    by simp

  have "b < d"
    using \<open>2*s = d^2 - b^2\<close> \<open>s > 0\<close> \<open>d > 0\<close> \<open>b > 0\<close>
    by (smt power_mono_iff zero_less_numeral)

  have "even b \<longleftrightarrow> even d"
    using \<open>2*s = d^2 - b^2\<close>
    by (metis add_uminus_conv_diff dvd_minus_iff even_add even_mult_iff even_numeral power2_eq_square)

  then have "b \<le> d - 2"
    using \<open>b < d\<close>
    by (smt even_two_times_div_two odd_two_times_div_two_succ)

  then have "2*s \<ge> d^2 - (d-2)^2"
    using \<open>2*s = d^2 - b^2\<close> \<open>d > 0\<close> \<open>b > 0\<close>
    by auto
  then have "s \<ge> 2*(d - 1)"
    by (simp add: algebra_simps power2_eq_square)
  then have "2*d \<le> s + 2"
    by simp
  then have "4*d^2 \<le> (s + 2)^2"
    using abs_le_square_iff[of "2*d" "s + 2"] \<open>d > 0\<close> \<open>s > 0\<close>
    by auto
  then have "2*s^2 < (s+2)^2"
    using \<open>2*s^2 < 4*d^2\<close>
    by simp
  then have "(s - 2)^2 < 8"
    by (simp add: power2_eq_square algebra_simps)
  then have "(s - 2)^2 < 3^2"
    by simp
  then have "s - 2 < 3"
    using power2_less_imp_less
    by fastforce
  then have "s \<le> 4"
    by simp
  then have "s = 1 \<or> s = 2 \<or> s = 3 \<or> s = 4"
    using \<open>s > 0\<close>
    by auto
  moreover
  have "\<And> p q :: int. \<lbrakk>16 = p^2 + q^2; p \<ge> 0; q \<ge> 0\<rbrakk> \<Longrightarrow> p = 0 \<or> q = 0"
  proof-
    fix p q :: int
    assume "16 = p^2 + q^2" "p \<ge> 0" "q \<ge> 0"
    have "p \<le> 4"
    proof (rule ccontr)
      assume "\<not> ?thesis"
      then have "p \<ge> 5"
        by simp
      then have "p^2 \<ge> 25"
        using power_mono[of 5 p 2]
        by simp
      then have "p^2 + q^2 \<ge> 25"
        using zero_le_power2[of q]
        by linarith
      then show False
        using \<open>16 = p^2 + q^2\<close>
        by auto
    qed
    then have "p = 0 \<or> p = 1 \<or> p = 2 \<or> p = 3 \<or> p = 4"
      using \<open>0 \<le> p\<close>
      by auto
    then show "p = 0 \<or> q = 0"
      using \<open>16 = p^2 + q^2\<close> not_perfect_square_15 not_perfect_square_12 not_perfect_square_7
      by auto
  qed
  moreover
  have "\<And> p q :: int. \<lbrakk>9 = p^2 + q^2; p \<ge> 0; q \<ge> 0\<rbrakk> \<Longrightarrow> p = 0 \<or> q = 0"
  proof-
    fix p q :: int
    assume "9 = p^2 + q^2" "p \<ge> 0" "q \<ge> 0"
    have "p \<le> 3"
    proof (rule ccontr)
      assume "\<not> ?thesis"
      then have "p \<ge> 4"
        by simp
      then have "p^2 \<ge> 16"
        using power_mono[of 4 p 2]
        by simp
      then have "p^2 + q^2 \<ge> 16"
        using zero_le_power2[of q]
        by linarith
      then show False
        using \<open>9 = p^2 + q^2\<close>
        by auto
    qed
    then have "p = 0 \<or> p = 1 \<or> p = 2 \<or> p = 3"
      using \<open>0 \<le> p\<close>
      by auto
    then show "p = 0 \<or> q = 0"
      using \<open>9 = p^2 + q^2\<close> not_perfect_square_8 not_perfect_square_5
      by auto
  qed
  moreover
  have "\<And> p q :: int. \<lbrakk>4 = p^2 + q^2; p \<ge> 0; q \<ge> 0\<rbrakk> \<Longrightarrow> p = 0 \<or> q = 0"
  proof-
    fix p q :: int
    assume "4 = p^2 + q^2" "p \<ge> 0" "q \<ge> 0"
    have "p \<le> 2"
    proof (rule ccontr)
      assume "\<not> ?thesis"
      then have "p \<ge> 3"
        by simp
      then have "p^2 \<ge> 9"
        using power_mono[of 3 p 2]
        by simp
      then have "p^2 + q^2 \<ge> 9"
        using zero_le_power2[of q]
        by linarith
      then show False
        using \<open>4 = p^2 + q^2\<close>
        by auto
    qed
    then have "p = 0 \<or> p = 1 \<or> p = 2"
      using \<open>0 \<le> p\<close>
      by auto
    then show "p = 0 \<or> q = 0"
      using \<open>4 = p^2 + q^2\<close> not_perfect_square_3
      by auto
  qed
  moreover
  have "\<And> p q :: int. \<lbrakk>1 = p^2 + q^2; p \<ge> 0; q \<ge> 0\<rbrakk> \<Longrightarrow> p = 0 \<or> q = 0"
    by (smt one_le_power)
  moreover
  have "a \<noteq> 0" "d \<noteq> 0"
    using \<open>a > 0\<close> \<open>d > 0\<close>
    by auto
  ultimately
  have "c = 0" "b = 0"
    using \<open>s^2 = c^2 + d^2\<close> \<open>d \<ge> 0\<close> \<open>c \<ge> 0\<close> \<open>s^2 = a^2 + b^2\<close> \<open>a \<ge> 0\<close> \<open>b \<ge> 0\<close>
    by fastforce+
  then show False
    using \<open>b > 0 \<or> c > 0\<close>
    by auto
qed

theorem IMO2018SL_N5:
  fixes x y z t :: int
  assumes pos: "x > 0" "y > 0" "z > 0" "t > 0"
  assumes eq: "x*y - z*t = x + y" "x + y = z + t"
  shows " \<not> (perfect_square (x*y) \<and> perfect_square (z*t))"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then obtain a c where "x*y = a*a" "z*t = c*c" "a > 0" "c > 0"
    using perfect_square_root_pos pos
    by (smt zero_less_mult_iff)

  show False
  proof (cases "odd (x + y)")
    case True

    have "even (x * y)"
      using True
      by auto

    moreover

    have "odd (z + t)"
      using True eq(2)
      by simp
    then have "even (z * t)"
      by auto

    ultimately

    have "even (x*y - z*t)"
      by simp
    then show False
      using eq(1) True
      by simp
  next
    case False
    then have "even (x + y)" "even (z + t)"
      using eq(2)
      by auto

    let ?s = "(x + y) div 2"
    let ?b = "abs (x - y) div 2" and ?d = "abs (z - t) div 2"

    have "?s ^ 2 = a ^ 2 + ?b ^ 2"
    proof-
      have "a^2 + ?b^2 = (x+y)^2 div 4"
        using \<open>even (x+y)\<close> div_power[of 2 "abs (x - y)" 2] \<open>x*y = a*a\<close>
        by (simp add: power2_eq_square algebra_simps)
      then show ?thesis
        by (metis False div_power mult_2_right numeral_Bit0 power2_eq_square)
    qed

    have "?s ^ 2 = c ^ 2 + ?d ^ 2"
    proof-
      have "c^2 + ?d^2 = (z+t)^2 div 4"
        using \<open>even (z+t)\<close> div_power[of 2 "abs (z - t)" 2] \<open>z*t = c*c\<close>
        by (simp add: power2_eq_square algebra_simps)
      then show ?thesis
        by (metis eq(2) False div_power mult_2_right numeral_Bit0 power2_eq_square)
    qed

    have "2*?s = a^2 - c^2"
      using \<open>even (x + y)\<close> \<open>x*y = a*a\<close> \<open>z*t = c*c\<close> eq(1)
      by (simp add: power2_eq_square)

    have "?s > 0"
      using \<open>x > 0\<close> \<open>y > 0\<close>
      by auto

    have "?b \<ge> 0" "?d \<ge> 0"
      by simp_all

    show ?thesis
    proof (cases "?b \<ge> c")
      case True
      then show False
        using IMO2018SL_N5_lemma[of "?s" a ?b c ?d]
        using \<open>?s^2 = a^2 + ?b^2\<close> \<open>?s^2 = c^2 + ?d^2\<close> \<open>2*?s = a^2 - c^2\<close>
        using \<open>a > 0\<close> \<open>c > 0\<close> \<open>?s > 0\<close> \<open>?d \<ge> 0\<close>
        by simp
    next
      case False
      then have "c \<ge> ?b"
        by simp
      then show False
        using IMO2018SL_N5_lemma[of "?s" ?d c ?b a]
        using \<open>?s^2 = a^2 + ?b^2\<close> \<open>?s^2 = c^2 + ?d^2\<close> \<open>2*?s = a^2 - c^2\<close>
        using \<open>a > 0\<close> \<open>c > 0\<close> \<open>?s > 0\<close> \<open>?b \<ge> 0\<close> \<open>?d \<ge> 0\<close>
        by simp
    qed
  qed
qed

end


(*  Title:      HOL/Analysis/Lebesgue_Integral_Substitution.thy
    Author:     Manuel Eberl

    Provides lemmas for integration by substitution for the basic integral types.
    Note that the substitution function must have a nonnegative derivative.
    This could probably be weakened somehow.
*)

section \<open>Integration by Substition for the Lebesgue Integral\<close>

theory Lebesgue_Integral_Substitution
imports Interval_Integral
begin

lemma nn_integral_substitution_aux:
  fixes f :: "real \<Rightarrow> ennreal"
  assumes Mf: "f \<in> borel_measurable borel"
  assumes nonnegf: "\<And>x. f x \<ge> 0"
  assumes derivg: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
  assumes contg': "continuous_on {a..b} g'"
  assumes derivg_nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
  assumes "a < b"
  shows "(\<integral>\<^sup>+x. f x * indicator {g a..g b} x \<partial>lborel) =
             (\<integral>\<^sup>+x. f (g x) * g' x * indicator {a..b} x \<partial>lborel)"
proof-
  from \<open>a < b\<close> have [simp]: "a \<le> b" by simp
  from derivg have contg: "continuous_on {a..b} g" by (rule has_real_derivative_imp_continuous_on)
  from this and contg' have Mg: "set_borel_measurable borel {a..b} g" and
                             Mg': "set_borel_measurable borel {a..b} g'"
      by (simp_all only: set_measurable_continuous_on_ivl)
  from derivg have derivg': "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
    by (simp only: has_real_derivative_iff_has_vector_derivative)

  have real_ind[simp]: "\<And>A x. enn2real (indicator A x) = indicator A x"
      by (auto split: split_indicator)
  have ennreal_ind[simp]: "\<And>A x. ennreal (indicator A x) = indicator A x"
      by (auto split: split_indicator)
  have [simp]: "\<And>x A. indicator A (g x) = indicator (g -` A) x"
      by (auto split: split_indicator)

  from derivg derivg_nonneg have monog: "\<And>x y. a \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> b \<Longrightarrow> g x \<le> g y"
    by (rule deriv_nonneg_imp_mono) simp_all
  with monog have [simp]: "g a \<le> g b" by (auto intro: mono_onD)

  show ?thesis
  proof (induction rule: borel_measurable_induct[OF Mf, case_names cong set mult add sup])
    case (cong f1 f2)
    from cong.hyps(3) have "f1 = f2" by auto
    with cong show ?case by simp
  next
    case (set A)
    from set.hyps show ?case
    proof (induction rule: borel_set_induct)
      case empty
      thus ?case by simp
    next
      case (interval c d)
      {
        fix u v :: real assume asm: "{u..v} \<subseteq> {g a..g b}" "u \<le> v"

        obtain u' v' where u'v': "{a..b} \<inter> g-`{u..v} = {u'..v'}" "u' \<le> v'" "g u' = u" "g v' = v"
             using asm by (rule_tac continuous_interval_vimage_Int[OF contg monog, of u v]) simp_all
        hence "{u'..v'} \<subseteq> {a..b}" "{u'..v'} \<subseteq> g -` {u..v}" by blast+
        with u'v'(2) have "u' \<in> g -` {u..v}" "v' \<in> g -` {u..v}" by auto
        from u'v'(1) have [simp]: "{a..b} \<inter> g -` {u..v} \<in> sets borel" by simp

        have A: "continuous_on {min u' v'..max u' v'} g'"
            by (simp only: u'v' max_absorb2 min_absorb1)
               (intro continuous_on_subset[OF contg'], insert u'v', auto)
        have "\<And>x. x \<in> {u'..v'} \<Longrightarrow> (g has_real_derivative g' x) (at x within {u'..v'})"
           using asm by (intro has_field_derivative_subset[OF derivg] subsetD[OF \<open>{u'..v'} \<subseteq> {a..b}\<close>]) auto
        hence B: "\<And>x. min u' v' \<le> x \<Longrightarrow> x \<le> max u' v' \<Longrightarrow>
                      (g has_vector_derivative g' x) (at x within {min u' v'..max u' v'})"
            by (simp only: u'v' max_absorb2 min_absorb1)
               (auto simp: has_real_derivative_iff_has_vector_derivative)
          have "integrable lborel (\<lambda>x. indicator ({a..b} \<inter> g -` {u..v}) x *\<^sub>R g' x)"
            using set_integrable_subset borel_integrable_atLeastAtMost'[OF contg']
            by (metis \<open>{u'..v'} \<subseteq> {a..b}\<close> eucl_ivals(5) set_integrable_def sets_lborel u'v'(1))
        hence "(\<integral>\<^sup>+x. ennreal (g' x) * indicator ({a..b} \<inter> g-` {u..v}) x \<partial>lborel) =
                   LBINT x:{a..b} \<inter> g-`{u..v}. g' x"
          unfolding set_lebesgue_integral_def
          by (subst nn_integral_eq_integral[symmetric])
             (auto intro!: derivg_nonneg nn_integral_cong split: split_indicator)
        also from interval_integral_FTC_finite[OF A B]
            have "LBINT x:{a..b} \<inter> g-`{u..v}. g' x = v - u"
                by (simp add: u'v' interval_integral_Icc \<open>u \<le> v\<close>)
        finally have "(\<integral>\<^sup>+ x. ennreal (g' x) * indicator ({a..b} \<inter> g -` {u..v}) x \<partial>lborel) =
                           ennreal (v - u)" .
      } note A = this

      have "(\<integral>\<^sup>+x. indicator {c..d} (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel) =
               (\<integral>\<^sup>+ x. ennreal (g' x) * indicator ({a..b} \<inter> g -` {c..d}) x \<partial>lborel)"
        by (intro nn_integral_cong) (simp split: split_indicator)
      also have "{a..b} \<inter> g-`{c..d} = {a..b} \<inter> g-`{max (g a) c..min (g b) d}"
        using \<open>a \<le> b\<close> \<open>c \<le> d\<close>
        by (auto intro!: monog intro: order.trans)
      also have "(\<integral>\<^sup>+ x. ennreal (g' x) * indicator ... x \<partial>lborel) =
        (if max (g a) c \<le> min (g b) d then min (g b) d - max (g a) c else 0)"
         using \<open>c \<le> d\<close> by (simp add: A)
      also have "... = (\<integral>\<^sup>+ x. indicator ({g a..g b} \<inter> {c..d}) x \<partial>lborel)"
        by (subst nn_integral_indicator) (auto intro!: measurable_sets Mg simp:)
      also have "... = (\<integral>\<^sup>+ x. indicator {c..d} x * indicator {g a..g b} x \<partial>lborel)"
        by (intro nn_integral_cong) (auto split: split_indicator)
      finally show ?case ..

      next

      case (compl A)
      note \<open>A \<in> sets borel\<close>[measurable]
      from emeasure_mono[of "A \<inter> {g a..g b}" "{g a..g b}" lborel]
      have [simp]: "emeasure lborel (A \<inter> {g a..g b}) \<noteq> top" by (auto simp: top_unique)
      have [simp]: "g -` A \<inter> {a..b} \<in> sets borel"
        by (rule set_borel_measurable_sets[OF Mg]) auto
      have [simp]: "g -` (-A) \<inter> {a..b} \<in> sets borel"
        by (rule set_borel_measurable_sets[OF Mg]) auto

      have "(\<integral>\<^sup>+x. indicator (-A) x * indicator {g a..g b} x \<partial>lborel) =
                (\<integral>\<^sup>+x. indicator (-A \<inter> {g a..g b}) x \<partial>lborel)"
        by (rule nn_integral_cong) (simp split: split_indicator)
      also from compl have "... = emeasure lborel ({g a..g b} - A)" using derivg_nonneg
        by (simp add: vimage_Compl diff_eq Int_commute[of "-A"])
      also have "{g a..g b} - A = {g a..g b} - A \<inter> {g a..g b}" by blast
      also have "emeasure lborel ... = g b - g a - emeasure lborel (A \<inter> {g a..g b})"
             using \<open>A \<in> sets borel\<close> by (subst emeasure_Diff) auto
     also have "emeasure lborel (A \<inter> {g a..g b}) =
                    \<integral>\<^sup>+x. indicator A x * indicator {g a..g b} x \<partial>lborel"
       using \<open>A \<in> sets borel\<close>
       by (subst nn_integral_indicator[symmetric], simp, intro nn_integral_cong)
          (simp split: split_indicator)
      also have "... = \<integral>\<^sup>+ x. indicator (g-`A \<inter> {a..b}) x * ennreal (g' x * indicator {a..b} x) \<partial>lborel" (is "_ = ?I")
        by (subst compl.IH, intro nn_integral_cong) (simp split: split_indicator)
      also have "g b - g a = LBINT x:{a..b}. g' x" using derivg'
        unfolding set_lebesgue_integral_def
        by (intro integral_FTC_atLeastAtMost[symmetric])
           (auto intro: continuous_on_subset[OF contg'] has_field_derivative_subset[OF derivg]
                 has_vector_derivative_at_within)
      also have "ennreal ... = \<integral>\<^sup>+ x. g' x * indicator {a..b} x \<partial>lborel"
        using borel_integrable_atLeastAtMost'[OF contg'] unfolding set_lebesgue_integral_def
        by (subst nn_integral_eq_integral)
           (simp_all add: mult.commute derivg_nonneg set_integrable_def split: split_indicator)
      also have Mg'': "(\<lambda>x. indicator (g -` A \<inter> {a..b}) x * ennreal (g' x * indicator {a..b} x))
                            \<in> borel_measurable borel" using Mg'
        by (intro borel_measurable_times_ennreal borel_measurable_indicator)
           (simp_all add: mult.commute set_borel_measurable_def)
      have le: "(\<integral>\<^sup>+x. indicator (g-`A \<inter> {a..b}) x * ennreal (g' x * indicator {a..b} x) \<partial>lborel) \<le>
                        (\<integral>\<^sup>+x. ennreal (g' x) * indicator {a..b} x \<partial>lborel)"
         by (intro nn_integral_mono) (simp split: split_indicator add: derivg_nonneg)
      note integrable = borel_integrable_atLeastAtMost'[OF contg']
      with le have notinf: "(\<integral>\<^sup>+x. indicator (g-`A \<inter> {a..b}) x * ennreal (g' x * indicator {a..b} x) \<partial>lborel) \<noteq> top"
          by (auto simp: real_integrable_def nn_integral_set_ennreal mult.commute top_unique set_integrable_def)
      have "(\<integral>\<^sup>+ x. g' x * indicator {a..b} x \<partial>lborel) - ?I =
                  \<integral>\<^sup>+ x. ennreal (g' x * indicator {a..b} x) -
                        indicator (g -` A \<inter> {a..b}) x * ennreal (g' x * indicator {a..b} x) \<partial>lborel"
        apply (intro nn_integral_diff[symmetric])
        apply (insert Mg', simp add: mult.commute set_borel_measurable_def) []
        apply (insert Mg'', simp) []
        apply (simp split: split_indicator add: derivg_nonneg)
        apply (rule notinf)
        apply (simp split: split_indicator add: derivg_nonneg)
        done
      also have "... = \<integral>\<^sup>+ x. indicator (-A) (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel"
        by (intro nn_integral_cong) (simp split: split_indicator)
      finally show ?case .

    next
      case (union f)
      then have [simp]: "\<And>i. {a..b} \<inter> g -` f i \<in> sets borel"
        by (subst Int_commute, intro set_borel_measurable_sets[OF Mg]) auto
      have "g -` (\<Union>i. f i) \<inter> {a..b} = (\<Union>i. {a..b} \<inter> g -` f i)" by auto
      hence "g -` (\<Union>i. f i) \<inter> {a..b} \<in> sets borel" by (auto simp del: UN_simps)

      have "(\<integral>\<^sup>+x. indicator (\<Union>i. f i) x * indicator {g a..g b} x \<partial>lborel) =
                \<integral>\<^sup>+x. indicator (\<Union>i. {g a..g b} \<inter> f i) x \<partial>lborel"
          by (intro nn_integral_cong) (simp split: split_indicator)
      also from union have "... = emeasure lborel (\<Union>i. {g a..g b} \<inter> f i)" by simp
      also from union have "... = (\<Sum>i. emeasure lborel ({g a..g b} \<inter> f i))"
        by (intro suminf_emeasure[symmetric]) (auto simp: disjoint_family_on_def)
      also from union have "... = (\<Sum>i. \<integral>\<^sup>+x. indicator ({g a..g b} \<inter> f i) x \<partial>lborel)" by simp
      also have "(\<lambda>i. \<integral>\<^sup>+x. indicator ({g a..g b} \<inter> f i) x \<partial>lborel) =
                           (\<lambda>i. \<integral>\<^sup>+x. indicator (f i) x * indicator {g a..g b} x \<partial>lborel)"
        by (intro ext nn_integral_cong) (simp split: split_indicator)
      also from union.IH have "(\<Sum>i. \<integral>\<^sup>+x. indicator (f i) x * indicator {g a..g b} x \<partial>lborel) =
          (\<Sum>i. \<integral>\<^sup>+ x. indicator (f i) (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel)" by simp
      also have "(\<lambda>i. \<integral>\<^sup>+ x. indicator (f i) (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel) =
                         (\<lambda>i. \<integral>\<^sup>+ x. ennreal (g' x * indicator {a..b} x) * indicator ({a..b} \<inter> g -` f i) x \<partial>lborel)"
        by (intro ext nn_integral_cong) (simp split: split_indicator)
      also have "(\<Sum>i. ... i) = \<integral>\<^sup>+ x. (\<Sum>i. ennreal (g' x * indicator {a..b} x) * indicator ({a..b} \<inter> g -` f i) x) \<partial>lborel"
        using Mg'
        apply (intro nn_integral_suminf[symmetric])
        apply (rule borel_measurable_times_ennreal, simp add: mult.commute set_borel_measurable_def)
        apply (rule borel_measurable_indicator, subst sets_lborel)
        apply (simp_all split: split_indicator add: derivg_nonneg)
        done
      also have "(\<lambda>x i. ennreal (g' x * indicator {a..b} x) * indicator ({a..b} \<inter> g -` f i) x) =
                      (\<lambda>x i. ennreal (g' x * indicator {a..b} x) * indicator (g -` f i) x)"
        by (intro ext) (simp split: split_indicator)
      also have "(\<integral>\<^sup>+ x. (\<Sum>i. ennreal (g' x * indicator {a..b} x) * indicator (g -` f i) x) \<partial>lborel) =
                     \<integral>\<^sup>+ x. ennreal (g' x * indicator {a..b} x) * (\<Sum>i. indicator (g -` f i) x) \<partial>lborel"
        by (intro nn_integral_cong) (auto split: split_indicator simp: derivg_nonneg)
      also from union have "(\<lambda>x. \<Sum>i. indicator (g -` f i) x :: ennreal) = (\<lambda>x. indicator (\<Union>i. g -` f i) x)"
        by (intro ext suminf_indicator) (auto simp: disjoint_family_on_def)
      also have "(\<integral>\<^sup>+x. ennreal (g' x * indicator {a..b} x) * ... x \<partial>lborel) =
                    (\<integral>\<^sup>+x. indicator (\<Union>i. f i) (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel)"
       by (intro nn_integral_cong) (simp split: split_indicator)
      finally show ?case .
  qed

next
  case (mult f c)
    note Mf[measurable] = \<open>f \<in> borel_measurable borel\<close>
    let ?I = "indicator {a..b}"
    have "(\<lambda>x. f (g x * ?I x) * ennreal (g' x * ?I x)) \<in> borel_measurable borel" using Mg Mg'
      by (intro borel_measurable_times_ennreal measurable_compose[OF _ Mf])
         (simp_all add: mult.commute set_borel_measurable_def)
    also have "(\<lambda>x. f (g x * ?I x) * ennreal (g' x * ?I x)) = (\<lambda>x. f (g x) * ennreal (g' x) * ?I x)"
      by (intro ext) (simp split: split_indicator)
    finally have Mf': "(\<lambda>x. f (g x) * ennreal (g' x) * ?I x) \<in> borel_measurable borel" .
    with mult show ?case
      by (subst (1 2 3) mult_ac, subst (1 2) nn_integral_cmult) (simp_all add: mult_ac)

next
  case (add f2 f1)
    let ?I = "indicator {a..b}"
    {
      fix f :: "real \<Rightarrow> ennreal" assume Mf: "f \<in> borel_measurable borel"
      have "(\<lambda>x. f (g x * ?I x) * ennreal (g' x * ?I x)) \<in> borel_measurable borel" using Mg Mg'
        by (intro borel_measurable_times_ennreal measurable_compose[OF _ Mf])
           (simp_all add:  mult.commute set_borel_measurable_def)
      also have "(\<lambda>x. f (g x * ?I x) * ennreal (g' x * ?I x)) = (\<lambda>x. f (g x) * ennreal (g' x) * ?I x)"
        by (intro ext) (simp split: split_indicator)
      finally have "(\<lambda>x. f (g x) * ennreal (g' x) * ?I x) \<in> borel_measurable borel" .
    } note Mf' = this[OF \<open>f1 \<in> borel_measurable borel\<close>] this[OF \<open>f2 \<in> borel_measurable borel\<close>]

    have "(\<integral>\<^sup>+ x. (f1 x + f2 x) * indicator {g a..g b} x \<partial>lborel) =
             (\<integral>\<^sup>+ x. f1 x * indicator {g a..g b} x + f2 x * indicator {g a..g b} x \<partial>lborel)"
      by (intro nn_integral_cong) (simp split: split_indicator)
    also from add have "... = (\<integral>\<^sup>+ x. f1 (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel) +
                                (\<integral>\<^sup>+ x. f2 (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel)"
      by (simp_all add: nn_integral_add)
    also from add have "... = (\<integral>\<^sup>+ x. f1 (g x) * ennreal (g' x) * indicator {a..b} x +
                                      f2 (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel)"
      by (intro nn_integral_add[symmetric])
         (auto simp add: Mf' derivg_nonneg split: split_indicator)
    also have "... = \<integral>\<^sup>+ x. (f1 (g x) + f2 (g x)) * ennreal (g' x) * indicator {a..b} x \<partial>lborel"
      by (intro nn_integral_cong) (simp split: split_indicator add: distrib_right)
    finally show ?case .

next
  case (sup F)
  {
    fix i
    let ?I = "indicator {a..b}"
    have "(\<lambda>x. F i (g x * ?I x) * ennreal (g' x * ?I x)) \<in> borel_measurable borel" using Mg Mg'
      by (rule_tac borel_measurable_times_ennreal, rule_tac measurable_compose[OF _ sup.hyps(1)])
         (simp_all add: mult.commute set_borel_measurable_def)
    also have "(\<lambda>x. F i (g x * ?I x) * ennreal (g' x * ?I x)) = (\<lambda>x. F i (g x) * ennreal (g' x) * ?I x)"
      by (intro ext) (simp split: split_indicator)
     finally have "... \<in> borel_measurable borel" .
  } note Mf' = this

    have "(\<integral>\<^sup>+x. (SUP i. F i x) * indicator {g a..g b} x \<partial>lborel) =
               \<integral>\<^sup>+x. (SUP i. F i x* indicator {g a..g b} x) \<partial>lborel"
      by (intro nn_integral_cong) (simp split: split_indicator)
    also from sup have "... = (SUP i. \<integral>\<^sup>+x. F i x* indicator {g a..g b} x \<partial>lborel)"
      by (intro nn_integral_monotone_convergence_SUP)
         (auto simp: incseq_def le_fun_def split: split_indicator)
    also from sup have "... = (SUP i. \<integral>\<^sup>+x. F i (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel)"
      by simp
    also from sup have "... =  \<integral>\<^sup>+x. (SUP i. F i (g x) * ennreal (g' x) * indicator {a..b} x) \<partial>lborel"
      by (intro nn_integral_monotone_convergence_SUP[symmetric])
         (auto simp: incseq_def le_fun_def derivg_nonneg Mf' split: split_indicator
               intro!: mult_right_mono)
    also from sup have "... = \<integral>\<^sup>+x. (SUP i. F i (g x)) * ennreal (g' x) * indicator {a..b} x \<partial>lborel"
      by (subst mult.assoc, subst mult.commute, subst SUP_mult_left_ennreal)
         (auto split: split_indicator simp: derivg_nonneg mult_ac)
    finally show ?case by (simp add: image_comp)
  qed
qed

theorem nn_integral_substitution:
  fixes f :: "real \<Rightarrow> real"
  assumes Mf[measurable]: "set_borel_measurable borel {g a..g b} f"
  assumes derivg: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
  assumes contg': "continuous_on {a..b} g'"
  assumes derivg_nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
  assumes "a \<le> b"
  shows "(\<integral>\<^sup>+x. f x * indicator {g a..g b} x \<partial>lborel) =
             (\<integral>\<^sup>+x. f (g x) * g' x * indicator {a..b} x \<partial>lborel)"
proof (cases "a = b")
  assume "a \<noteq> b"
  with \<open>a \<le> b\<close> have "a < b" by auto
  let ?f' = "\<lambda>x. f x * indicator {g a..g b} x"

  from derivg derivg_nonneg have monog: "\<And>x y. a \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> b \<Longrightarrow> g x \<le> g y"
    by (rule deriv_nonneg_imp_mono) simp_all
  have bounds: "\<And>x. x \<ge> a \<Longrightarrow> x \<le> b \<Longrightarrow> g x \<ge> g a" "\<And>x. x \<ge> a \<Longrightarrow> x \<le> b \<Longrightarrow> g x \<le> g b"
    by (auto intro: monog)

  from derivg_nonneg have nonneg:
    "\<And>f x. x \<ge> a \<Longrightarrow> x \<le> b \<Longrightarrow> g' x \<noteq> 0 \<Longrightarrow> f x * ennreal (g' x) \<ge> 0 \<Longrightarrow> f x \<ge> 0"
    by (force simp: field_simps)
  have nonneg': "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<not> 0 \<le> f (g x) \<Longrightarrow> 0 \<le> f (g x) * g' x \<Longrightarrow> g' x = 0"
    by (metis atLeastAtMost_iff derivg_nonneg eq_iff mult_eq_0_iff mult_le_0_iff)

  have "(\<integral>\<^sup>+x. f x * indicator {g a..g b} x \<partial>lborel) =
            (\<integral>\<^sup>+x. ennreal (?f' x) * indicator {g a..g b} x \<partial>lborel)"
    by (intro nn_integral_cong)
       (auto split: split_indicator split_max simp: zero_ennreal.rep_eq ennreal_neg)
  also have "... = \<integral>\<^sup>+ x. ?f' (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel" using Mf
    by (subst nn_integral_substitution_aux[OF _ _ derivg contg' derivg_nonneg \<open>a < b\<close>])
       (auto simp add: mult.commute set_borel_measurable_def)
  also have "... = \<integral>\<^sup>+ x. f (g x) * ennreal (g' x) * indicator {a..b} x \<partial>lborel"
    by (intro nn_integral_cong) (auto split: split_indicator simp: max_def dest: bounds)
  also have "... = \<integral>\<^sup>+x. ennreal (f (g x) * g' x * indicator {a..b} x) \<partial>lborel"
    by (intro nn_integral_cong) (auto simp: mult.commute derivg_nonneg ennreal_mult' split: split_indicator)
  finally show ?thesis .
qed auto

theorem integral_substitution:
  assumes integrable: "set_integrable lborel {g a..g b} f"
  assumes derivg: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
  assumes contg': "continuous_on {a..b} g'"
  assumes derivg_nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
  assumes "a \<le> b"
  shows "set_integrable lborel {a..b} (\<lambda>x. f (g x) * g' x)"
    and "(LBINT x. f x * indicator {g a..g b} x) = (LBINT x. f (g x) * g' x * indicator {a..b} x)"
proof-
  from derivg have contg: "continuous_on {a..b} g" by (rule has_real_derivative_imp_continuous_on)
  with contg' have Mg: "set_borel_measurable borel {a..b} g"
    and Mg': "set_borel_measurable borel {a..b} g'"
    by (simp_all only: set_measurable_continuous_on_ivl)
  from derivg derivg_nonneg have monog: "\<And>x y. a \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> b \<Longrightarrow> g x \<le> g y"
    by (rule deriv_nonneg_imp_mono) simp_all

  have "(\<lambda>x. ennreal (f x) * indicator {g a..g b} x) =
           (\<lambda>x. ennreal (f x * indicator {g a..g b} x))"
    by (intro ext) (simp split: split_indicator)
  with integrable have M1: "(\<lambda>x. f x * indicator {g a..g b} x) \<in> borel_measurable borel"
    by (force simp: mult.commute set_integrable_def)
  from integrable have M2: "(\<lambda>x. -f x * indicator {g a..g b} x) \<in> borel_measurable borel"
    by (force simp: mult.commute set_integrable_def)

  have "LBINT x. (f x :: real) * indicator {g a..g b} x =
          enn2real (\<integral>\<^sup>+ x. ennreal (f x) * indicator {g a..g b} x \<partial>lborel) -
          enn2real (\<integral>\<^sup>+ x. ennreal (- (f x)) * indicator {g a..g b} x \<partial>lborel)" using integrable
    unfolding set_integrable_def
    by (subst real_lebesgue_integral_def) (simp_all add: nn_integral_set_ennreal mult.commute)
  also have *: "(\<integral>\<^sup>+x. ennreal (f x) * indicator {g a..g b} x \<partial>lborel) =
      (\<integral>\<^sup>+x. ennreal (f x * indicator {g a..g b} x) \<partial>lborel)"
    by (intro nn_integral_cong) (simp split: split_indicator)
  also from M1 * have A: "(\<integral>\<^sup>+ x. ennreal (f x * indicator {g a..g b} x) \<partial>lborel) =
                            (\<integral>\<^sup>+ x. ennreal (f (g x) * g' x * indicator {a..b} x) \<partial>lborel)"
    by (subst nn_integral_substitution[OF _ derivg contg' derivg_nonneg \<open>a \<le> b\<close>])
       (auto simp: nn_integral_set_ennreal mult.commute set_borel_measurable_def)
  also have **: "(\<integral>\<^sup>+ x. ennreal (- (f x)) * indicator {g a..g b} x \<partial>lborel) =
      (\<integral>\<^sup>+ x. ennreal (- (f x) * indicator {g a..g b} x) \<partial>lborel)"
    by (intro nn_integral_cong) (simp split: split_indicator)
  also from M2 ** have B: "(\<integral>\<^sup>+ x. ennreal (- (f x) * indicator {g a..g b} x) \<partial>lborel) =
        (\<integral>\<^sup>+ x. ennreal (- (f (g x)) * g' x * indicator {a..b} x) \<partial>lborel)"
    by (subst nn_integral_substitution[OF _ derivg contg' derivg_nonneg \<open>a \<le> b\<close>])
       (auto simp: nn_integral_set_ennreal mult.commute set_borel_measurable_def)

  also {
    from integrable have Mf: "set_borel_measurable borel {g a..g b} f"
      unfolding set_borel_measurable_def set_integrable_def by simp
    from measurable_compose Mg Mf Mg' borel_measurable_times
    have "(\<lambda>x. f (g x * indicator {a..b} x) * indicator {g a..g b} (g x * indicator {a..b} x) *
                     (g' x * indicator {a..b} x)) \<in> borel_measurable borel"  (is "?f \<in> _")
      by (simp add: mult.commute set_borel_measurable_def)
    also have "?f = (\<lambda>x. f (g x) * g' x * indicator {a..b} x)"
      using monog by (intro ext) (auto split: split_indicator)
    finally show "set_integrable lborel {a..b} (\<lambda>x. f (g x) * g' x)"
      using A B integrable unfolding real_integrable_def set_integrable_def
      by (simp_all add: nn_integral_set_ennreal mult.commute)
  } note integrable' = this

  have "enn2real (\<integral>\<^sup>+ x. ennreal (f (g x) * g' x * indicator {a..b} x) \<partial>lborel) -
                  enn2real (\<integral>\<^sup>+ x. ennreal (-f (g x) * g' x * indicator {a..b} x) \<partial>lborel) =
                (LBINT x. f (g x) * g' x * indicator {a..b} x)"
    using integrable' unfolding set_integrable_def
    by (subst real_lebesgue_integral_def) (simp_all add: field_simps)
  finally show "(LBINT x. f x * indicator {g a..g b} x) =
                     (LBINT x. f (g x) * g' x * indicator {a..b} x)" .
qed

theorem interval_integral_substitution:
  assumes integrable: "set_integrable lborel {g a..g b} f"
  assumes derivg: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
  assumes contg': "continuous_on {a..b} g'"
  assumes derivg_nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
  assumes "a \<le> b"
  shows "set_integrable lborel {a..b} (\<lambda>x. f (g x) * g' x)"
    and "(LBINT x=g a..g b. f x) = (LBINT x=a..b. f (g x) * g' x)"
  apply (rule integral_substitution[OF assms], simp, simp)
  apply (subst (1 2) interval_integral_Icc, fact)
  apply (rule deriv_nonneg_imp_mono[OF derivg derivg_nonneg], simp, simp, fact)
  using integral_substitution(2)[OF assms]
  apply (simp add: mult.commute set_lebesgue_integral_def)
  done

lemma set_borel_integrable_singleton[simp]: "set_integrable lborel {x} (f :: real \<Rightarrow> real)"
  unfolding set_integrable_def
  by (subst integrable_discrete_difference[where X="{x}" and g="\<lambda>_. 0"]) auto

end


(*
  Authors: Asta Halkjær From, Agnes Moesgård Eschen & Jørgen Villadsen, DTU Compute
*)

theory SLAI_1 imports System_L1 begin

text \<open>Inspired by Larry Wos: Conquering the Meredith Single Axiom, J. Autom. Reas. 27:175–199 2001\<close>

inductive Single (\<open>\<tturnstile>\<close>) where
  MP: \<open>\<tturnstile> q\<close> if \<open>\<tturnstile> p\<close> and \<open>\<tturnstile> (p \<rightarrow> q)\<close> |
  AX: \<open>\<tturnstile> (((((p \<rightarrow> q) \<rightarrow> (\<sim> r \<rightarrow> \<sim> s)) \<rightarrow> r) \<rightarrow> t) \<rightarrow> ((t \<rightarrow> p) \<rightarrow> (s \<rightarrow> p)))\<close>

lemma L1_3: \<open>\<tturnstile> (p \<rightarrow> (\<sim> p \<rightarrow> q))\<close>
  using AX MP by metis

lemma 1: \<open>\<tturnstile> (((p \<rightarrow> q) \<rightarrow> r) \<rightarrow> (q \<rightarrow> r))\<close>
  using AX MP by metis

lemma 2: \<open>\<tturnstile> (p \<rightarrow> (((q \<rightarrow> p) \<rightarrow> r) \<rightarrow> (s \<rightarrow> r)))\<close>
  using 1 AX MP by metis

lemma 3: \<open>\<tturnstile> (p \<rightarrow> (((q \<rightarrow> r) \<rightarrow> s) \<rightarrow> (((r \<rightarrow> t) \<rightarrow> (\<sim> s \<rightarrow> \<sim> q)) \<rightarrow> s)))\<close>
  using 1 2 AX MP by meson

lemma 4: \<open>\<tturnstile> (((p \<rightarrow> q) \<rightarrow> (r \<rightarrow> (s \<rightarrow> (q \<rightarrow> t)))) \<rightarrow> (u \<rightarrow> (r \<rightarrow> (s \<rightarrow> (q \<rightarrow> t)))))\<close>
  using 2 3 AX MP by meson

lemma 5: \<open>\<tturnstile> (((p \<rightarrow> (\<sim> (\<sim> q) \<rightarrow> q)) \<rightarrow> r) \<rightarrow> r)\<close>
  using 1 4 AX MP by metis

lemma L1_2: \<open>\<tturnstile> ((\<sim> p \<rightarrow> p) \<rightarrow> p)\<close>
  using 1 4 5 AX MP by metis

lemma 6: \<open>\<tturnstile> (((p \<rightarrow> (q \<rightarrow> (\<sim> ((r \<rightarrow> (\<sim> (\<sim> s) \<rightarrow> s)) \<rightarrow> \<sim> q)))) \<rightarrow> t) \<rightarrow> t)\<close>
  using 4 5 AX MP by metis

lemma 7: \<open>\<tturnstile> (((((p \<rightarrow> (\<sim> (\<sim> q) \<rightarrow> q)) \<rightarrow> \<sim> (\<sim> r)) \<rightarrow> s) \<rightarrow> t) \<rightarrow> ((r \<rightarrow> s) \<rightarrow> t))\<close>
  using 6 AX MP by metis

lemma L1_1: \<open>\<tturnstile> ((p \<rightarrow> q) \<rightarrow> ((q \<rightarrow> r) \<rightarrow> (p \<rightarrow> r)))\<close>
  using 7 AX MP by metis

theorem \<open>\<turnstile> p \<longleftrightarrow> \<tturnstile> p\<close>
proof
  show \<open>\<turnstile> p\<close> if \<open>\<tturnstile> p\<close>
    using that by induct (use System_L1.MP in fast, use L1_completeness in simp)
  show \<open>\<tturnstile> p\<close> if \<open>\<turnstile> p\<close>
    using that by induct (use MP in fast, rule L1_1, rule L1_2, rule L1_3)
qed

end


(*  Title:      HOL/HOLCF/Library/Option_Cpo.thy
    Author:     Brian Huffman
*)

section \<open>Cpo class instance for HOL option type\<close>

theory Option_Cpo
imports HOLCF Sum_Cpo
begin

subsection \<open>Ordering on option type\<close>

instantiation option :: (below) below
begin

definition below_option_def:
  "x \<sqsubseteq> y \<equiv> case x of
         None \<Rightarrow> (case y of None \<Rightarrow> True | Some b \<Rightarrow> False) |
         Some a \<Rightarrow> (case y of None \<Rightarrow> False | Some b \<Rightarrow> a \<sqsubseteq> b)"

instance ..
end

lemma None_below_None [simp]: "None \<sqsubseteq> None"
unfolding below_option_def by simp

lemma Some_below_Some [simp]: "Some x \<sqsubseteq> Some y \<longleftrightarrow> x \<sqsubseteq> y"
unfolding below_option_def by simp

lemma Some_below_None [simp]: "\<not> Some x \<sqsubseteq> None"
unfolding below_option_def by simp

lemma None_below_Some [simp]: "\<not> None \<sqsubseteq> Some y"
unfolding below_option_def by simp

lemma Some_mono: "x \<sqsubseteq> y \<Longrightarrow> Some x \<sqsubseteq> Some y"
by simp

lemma None_below_iff [simp]: "None \<sqsubseteq> x \<longleftrightarrow> x = None"
by (cases x, simp_all)

lemma below_None_iff [simp]: "x \<sqsubseteq> None \<longleftrightarrow> x = None"
by (cases x, simp_all)

lemma option_below_cases:
  assumes "x \<sqsubseteq> y"
  obtains "x = None" and "y = None"
  | a b where "x = Some a" and "y = Some b" and "a \<sqsubseteq> b"
using assms unfolding below_option_def
by (simp split: option.split_asm)

subsection \<open>Option type is a complete partial order\<close>

instance option :: (po) po
proof
  fix x :: "'a option"
  show "x \<sqsubseteq> x"
    unfolding below_option_def
    by (simp split: option.split)
next
  fix x y :: "'a option"
  assume "x \<sqsubseteq> y" and "y \<sqsubseteq> x" thus "x = y"
    unfolding below_option_def
    by (auto split: option.split_asm intro: below_antisym)
next
  fix x y z :: "'a option"
  assume "x \<sqsubseteq> y" and "y \<sqsubseteq> z" thus "x \<sqsubseteq> z"
    unfolding below_option_def
    by (auto split: option.split_asm intro: below_trans)
qed

lemma monofun_the: "monofun the"
by (rule monofunI, erule option_below_cases, simp_all)

lemma option_chain_cases:
  assumes Y: "chain Y"
  obtains "Y = (\<lambda>i. None)" | A where "chain A" and "Y = (\<lambda>i. Some (A i))"
 apply (cases "Y 0")
  apply (rule that(1))
  apply (rule ext)
  apply (cut_tac j=i in chain_mono [OF Y le0], simp)
 apply (rule that(2))
  apply (rule ch2ch_monofun [OF monofun_the Y])
 apply (rule ext)
 apply (cut_tac j=i in chain_mono [OF Y le0], simp)
 apply (case_tac "Y i", simp_all)
done

lemma is_lub_Some: "range S <<| x \<Longrightarrow> range (\<lambda>i. Some (S i)) <<| Some x"
 apply (rule is_lubI)
  apply (rule ub_rangeI)
  apply (simp add: is_lub_rangeD1)
 apply (frule ub_rangeD [where i=arbitrary])
 apply (case_tac u, simp_all)
 apply (erule is_lubD2)
 apply (rule ub_rangeI)
 apply (drule ub_rangeD, simp)
done

instance option :: (cpo) cpo
 apply intro_classes
 apply (erule option_chain_cases, safe)
  apply (rule exI, rule is_lub_const)
 apply (rule exI)
 apply (rule is_lub_Some)
 apply (erule cpo_lubI)
done

subsection \<open>Continuity of Some and case function\<close>

lemma cont_Some: "cont Some"
by (intro contI is_lub_Some cpo_lubI)

lemmas cont2cont_Some [simp, cont2cont] = cont_compose [OF cont_Some]

lemmas ch2ch_Some [simp] = ch2ch_cont [OF cont_Some]

lemmas lub_Some = cont2contlubE [OF cont_Some, symmetric]

lemma cont2cont_case_option:
  assumes f: "cont (\<lambda>x. f x)"
  assumes g: "cont (\<lambda>x. g x)"
  assumes h1: "\<And>a. cont (\<lambda>x. h x a)"
  assumes h2: "\<And>x. cont (\<lambda>a. h x a)"
  shows "cont (\<lambda>x. case f x of None \<Rightarrow> g x | Some a \<Rightarrow> h x a)"
apply (rule cont_apply [OF f])
apply (rule contI)
apply (erule option_chain_cases)
apply (simp add: is_lub_const)
apply (simp add: lub_Some)
apply (simp add: cont2contlubE [OF h2])
apply (rule cpo_lubI, rule chainI)
apply (erule cont2monofunE [OF h2 chainE])
apply (case_tac y, simp_all add: g h1)
done

lemma cont2cont_case_option' [simp, cont2cont]:
  assumes f: "cont (\<lambda>x. f x)"
  assumes g: "cont (\<lambda>x. g x)"
  assumes h: "cont (\<lambda>p. h (fst p) (snd p))"
  shows "cont (\<lambda>x. case f x of None \<Rightarrow> g x | Some a \<Rightarrow> h x a)"
using assms by (simp add: cont2cont_case_option prod_cont_iff)

text \<open>Simple version for when the element type is not a cpo.\<close>

lemma cont2cont_case_option_simple [simp, cont2cont]:
  assumes "cont (\<lambda>x. f x)"
  assumes "\<And>a. cont (\<lambda>x. g x a)"
  shows "cont (\<lambda>x. case z of None \<Rightarrow> f x | Some a \<Rightarrow> g x a)"
using assms by (cases z) auto

text \<open>Continuity rule for map.\<close>

lemma cont2cont_map_option [simp, cont2cont]:
  assumes f: "cont (\<lambda>(x, y). f x y)"
  assumes g: "cont (\<lambda>x. g x)"
  shows "cont (\<lambda>x. map_option (\<lambda>y. f x y) (g x))"
using assms by (simp add: prod_cont_iff map_option_case)

subsection \<open>Compactness and chain-finiteness\<close>

lemma compact_None [simp]: "compact None"
apply (rule compactI2)
apply (erule option_chain_cases, safe)
apply simp
apply (simp add: lub_Some)
done

lemma compact_Some: "compact a \<Longrightarrow> compact (Some a)"
apply (rule compactI2)
apply (erule option_chain_cases, safe)
apply simp
apply (simp add: lub_Some)
apply (erule (2) compactD2)
done

lemma compact_Some_rev: "compact (Some a) \<Longrightarrow> compact a"
unfolding compact_def
by (drule adm_subst [OF cont_Some], simp)

lemma compact_Some_iff [simp]: "compact (Some a) = compact a"
by (safe elim!: compact_Some compact_Some_rev)

instance option :: (chfin) chfin
apply intro_classes
apply (erule compact_imp_max_in_chain)
apply (case_tac "\<Squnion>i. Y i", simp_all)
done

instance option :: (discrete_cpo) discrete_cpo
by intro_classes (simp add: below_option_def split: option.split)

subsection \<open>Using option types with Fixrec\<close>

definition
  "match_None = (\<Lambda> x k. case x of None \<Rightarrow> k | Some a \<Rightarrow> Fixrec.fail)"

definition
  "match_Some = (\<Lambda> x k. case x of None \<Rightarrow> Fixrec.fail | Some a \<Rightarrow> k\<cdot>a)"

lemma match_None_simps [simp]:
  "match_None\<cdot>None\<cdot>k = k"
  "match_None\<cdot>(Some a)\<cdot>k = Fixrec.fail"
unfolding match_None_def by simp_all

lemma match_Some_simps [simp]:
  "match_Some\<cdot>None\<cdot>k = Fixrec.fail"
  "match_Some\<cdot>(Some a)\<cdot>k = k\<cdot>a"
unfolding match_Some_def by simp_all

setup \<open>
  Fixrec.add_matchers
    [ (\<^const_name>\<open>None\<close>, \<^const_name>\<open>match_None\<close>),
      (\<^const_name>\<open>Some\<close>, \<^const_name>\<open>match_Some\<close>) ]
\<close>

subsection \<open>Option type is a predomain\<close>

definition
  "encode_option = (\<Lambda> x. case x of None \<Rightarrow> Inl () | Some a \<Rightarrow> Inr a)"

definition
  "decode_option = (\<Lambda> x. case x of Inl (u::unit) \<Rightarrow> None | Inr a \<Rightarrow> Some a)"

lemma decode_encode_option [simp]: "decode_option\<cdot>(encode_option\<cdot>x) = x"
unfolding decode_option_def encode_option_def
by (cases x, simp_all)

lemma encode_decode_option [simp]: "encode_option\<cdot>(decode_option\<cdot>x) = x"
unfolding decode_option_def encode_option_def
by (cases x, simp_all)

instantiation option :: (predomain) predomain
begin

definition
  "liftemb = liftemb oo u_map\<cdot>encode_option"

definition
  "liftprj = u_map\<cdot>decode_option oo liftprj"

definition
  "liftdefl (t::('a option) itself) = LIFTDEFL(unit + 'a)"

instance proof
  show "ep_pair liftemb (liftprj :: udom u \<rightarrow> ('a option) u)"
    unfolding liftemb_option_def liftprj_option_def
    apply (intro ep_pair_comp ep_pair_u_map predomain_ep)
    apply (rule ep_pair.intro, simp, simp)
    done
  show "cast\<cdot>LIFTDEFL('a option) = liftemb oo (liftprj :: udom u \<rightarrow> ('a option) u)"
    unfolding liftemb_option_def liftprj_option_def liftdefl_option_def
    by (simp add: cast_liftdefl cfcomp1 u_map_map ID_def [symmetric] u_map_ID)
qed

end

subsection \<open>Configuring domain package to work with option type\<close>

lemma liftdefl_option [domain_defl_simps]:
  "LIFTDEFL('a::predomain option) = LIFTDEFL(unit + 'a)"
by (rule liftdefl_option_def)

abbreviation option_map
  where "option_map f \<equiv> Abs_cfun (map_option (Rep_cfun f))"

lemma option_map_ID [domain_map_ID]: "option_map ID = ID"
by (simp add: ID_def cfun_eq_iff option.map_id[unfolded id_def] id_def)

lemma deflation_option_map [domain_deflation]:
  "deflation d \<Longrightarrow> deflation (option_map d)"
apply standard
apply (induct_tac x, simp_all add: deflation.idem)
apply (induct_tac x, simp_all add: deflation.below)
done

lemma encode_option_option_map:
  "encode_option\<cdot>(map_option (\<lambda>x. f\<cdot>x) (decode_option\<cdot>x)) = map_sum' ID f\<cdot>x"
by (induct x, simp_all add: decode_option_def encode_option_def)

lemma isodefl_option [domain_isodefl]:
  assumes "isodefl' d t"
  shows "isodefl' (option_map d) (sum_liftdefl\<cdot>(liftdefl_of\<cdot>DEFL(unit))\<cdot>t)"
using isodefl_sum [OF isodefl_LIFTDEFL [where 'a=unit] assms]
unfolding isodefl'_def liftemb_option_def liftprj_option_def liftdefl_eq
by (simp add: cfcomp1 u_map_map encode_option_option_map)

setup \<open>
  Domain_Take_Proofs.add_rec_type (\<^type_name>\<open>option\<close>, [true])
\<close>

end


(* Title:  Digraph.thy
   Author: Lars Noschinski, TU München
   Author: René Neumann
*)

theory Digraph
imports
  Main
  Rtrancl_On
  Stuff
begin

section \<open>Digraphs\<close>

record ('a,'b) pre_digraph =
  verts :: "'a set"
  arcs :: "'b set"
  tail :: "'b \<Rightarrow> 'a"
  head :: "'b \<Rightarrow> 'a"

definition arc_to_ends :: "('a,'b) pre_digraph \<Rightarrow> 'b \<Rightarrow> 'a \<times> 'a" where
  "arc_to_ends G e \<equiv> (tail G e, head G e)"

locale pre_digraph =
  fixes G :: "('a, 'b) pre_digraph" (structure)

locale wf_digraph = pre_digraph +
  assumes tail_in_verts[simp]: "e \<in> arcs G \<Longrightarrow> tail G e \<in> verts G"
  assumes head_in_verts[simp]: "e \<in> arcs G \<Longrightarrow> head G e \<in> verts G"
begin

lemma wf_digraph: "wf_digraph G" by intro_locales

lemmas wellformed = tail_in_verts head_in_verts

end

definition arcs_ends :: "('a,'b) pre_digraph \<Rightarrow> ('a \<times> 'a) set" where
  "arcs_ends G \<equiv> arc_to_ends G ` arcs G"

definition symmetric :: "('a,'b) pre_digraph \<Rightarrow> bool" where
  "symmetric G \<equiv> sym (arcs_ends G)"

text \<open>
  Matches "pseudo digraphs" from \cite{bangjensen2009digraphs}, except for
  allowing the null graph. For a discussion of that topic,
  see also \cite{harary1974nullgraph}.
\<close>
locale fin_digraph = wf_digraph +
  assumes finite_verts[simp]: "finite (verts G)"
    and finite_arcs[simp]: "finite (arcs G)"

locale loopfree_digraph = wf_digraph +
  assumes no_loops: "e \<in> arcs G \<Longrightarrow> tail G e \<noteq> head G e"

locale nomulti_digraph = wf_digraph +
  assumes no_multi_arcs: "\<And>e1 e2. \<lbrakk>e1 \<in> arcs G; e2 \<in> arcs G;
     arc_to_ends G e1 = arc_to_ends G e2\<rbrakk> \<Longrightarrow> e1 = e2"

locale sym_digraph = wf_digraph +
  assumes sym_arcs[intro]: "symmetric G"

locale digraph = fin_digraph + loopfree_digraph + nomulti_digraph

text \<open>
  We model graphs as symmetric digraphs. This is fine for many purposes,
  but not for all. For example, the path $a,b,a$ is considered to be a cycle
  in a digraph (and hence in a symmetric digraph), but not in an undirected
  graph.
\<close>
locale pseudo_graph = fin_digraph + sym_digraph

locale graph = digraph + pseudo_graph

lemma (in wf_digraph) fin_digraphI[intro]:
  assumes "finite (verts G)"
  assumes "finite (arcs G)"
  shows "fin_digraph G"
using assms by unfold_locales

lemma (in wf_digraph) sym_digraphI[intro]:
  assumes "symmetric G"
  shows "sym_digraph G"
using assms by unfold_locales

lemma (in digraph) graphI[intro]:
  assumes "symmetric G"
  shows "graph G"
using assms by unfold_locales

definition (in wf_digraph) arc :: "'b \<Rightarrow> 'a \<times> 'a \<Rightarrow> bool" where
  "arc e uv \<equiv> e \<in> arcs G \<and> tail G e = fst uv \<and> head G e = snd uv"

lemma (in fin_digraph) fin_digraph: "fin_digraph G"
  by unfold_locales

lemma (in nomulti_digraph) nomulti_digraph: "nomulti_digraph G" by unfold_locales

lemma arcs_ends_conv: "arcs_ends G = (\<lambda>e. (tail G e, head G e)) ` arcs G"
  by (auto simp: arc_to_ends_def arcs_ends_def)

lemma symmetric_conv: "symmetric G \<longleftrightarrow> (\<forall>e1 \<in> arcs G. \<exists>e2 \<in> arcs G. tail G e1 = head G e2 \<and> head G e1 = tail G e2)"
  unfolding symmetric_def arcs_ends_conv sym_def by auto

lemma arcs_ends_symmetric:
  assumes "symmetric G"
  shows "(u,v) \<in> arcs_ends G \<Longrightarrow> (v,u) \<in> arcs_ends G"
  using assms unfolding symmetric_def sym_def by auto

lemma (in nomulti_digraph) inj_on_arc_to_ends:
  "inj_on (arc_to_ends G) (arcs G)"
  by (rule inj_onI) (rule no_multi_arcs)

subsection \<open>Reachability\<close>

abbreviation dominates :: "('a,'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("_ \<rightarrow>\<index> _" [100,100] 40) where
  "dominates G u v \<equiv> (u,v) \<in> arcs_ends G"

abbreviation reachable1 :: "('a,'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("_ \<rightarrow>\<^sup>+\<index> _" [100,100] 40) where
  "reachable1 G u v \<equiv> (u,v) \<in> (arcs_ends G)^+"

definition reachable :: "('a,'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("_ \<rightarrow>\<^sup>*\<index> _" [100,100] 40) where
  "reachable G u v \<equiv> (u,v) \<in> rtrancl_on (verts G) (arcs_ends G)"

lemma reachableE[elim]:
  assumes "u \<rightarrow>\<^bsub>G\<^esub> v"
  obtains e where "e \<in> arcs G" "tail G e = u" "head G e = v"
using assms by (auto simp add: arcs_ends_conv)

lemma (in loopfree_digraph) adj_not_same:
  assumes "a \<rightarrow> a" shows "False"
  using assms by (rule reachableE) (auto dest: no_loops)

lemma reachable_in_vertsE:
  assumes "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v" obtains "u \<in> verts G" "v \<in> verts G"
  using assms unfolding reachable_def by induct auto

lemma reachable_rtranclI:
  "u \<rightarrow>\<^sup>*\<^bsub>G \<^esub> v \<Longrightarrow> (u, v) \<in> (arcs_ends G)\<^sup>*"
  unfolding reachable_def by (rule rtrancl_on_rtranclI)

context wf_digraph begin

lemma adj_in_verts:
  assumes "u \<rightarrow>\<^bsub>G\<^esub> v" shows "u \<in> verts G" "v \<in> verts G"
  using assms unfolding arcs_ends_conv by auto

lemma dominatesI: assumes "arc_to_ends G a = (u,v)" "a \<in> arcs G" shows "u \<rightarrow>\<^bsub>G\<^esub> v"
  using assms by (auto simp: arcs_ends_def intro: rev_image_eqI)

lemma reachable_refl [intro!, Pure.intro!, simp]: "v \<in> verts G \<Longrightarrow> v \<rightarrow>\<^sup>* v"
  unfolding reachable_def by auto

lemma adj_reachable_trans[trans]:
  assumes "a \<rightarrow>\<^bsub>G\<^esub> b" "b \<rightarrow>\<^sup>*\<^bsub>G\<^esub> c" shows "a \<rightarrow>\<^sup>*\<^bsub>G\<^esub> c"
  using assms by (auto simp: reachable_def intro: converse_rtrancl_on_into_rtrancl_on adj_in_verts)

lemma reachable_adj_trans[trans]:
  assumes "a \<rightarrow>\<^sup>*\<^bsub>G\<^esub> b" "b \<rightarrow>\<^bsub>G\<^esub> c" shows "a \<rightarrow>\<^sup>*\<^bsub>G\<^esub> c"
  using assms by (auto simp: reachable_def intro: rtrancl_on_into_rtrancl_on adj_in_verts)

lemma reachable_adjI [intro, simp]: "u \<rightarrow> v \<Longrightarrow> u \<rightarrow>\<^sup>* v"
  by (auto intro: adj_reachable_trans adj_in_verts)

lemma reachable_trans[trans]:
  assumes "u \<rightarrow>\<^sup>*v" "v \<rightarrow>\<^sup>* w" shows "u \<rightarrow>\<^sup>* w"
  using assms unfolding reachable_def by (rule rtrancl_on_trans)

lemma reachable_induct[consumes 1, case_names base step]:
  assumes major: "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
    and cases: "u \<in> verts G \<Longrightarrow> P u"
       "\<And>x y. \<lbrakk>u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> x; x \<rightarrow>\<^bsub>G\<^esub> y; P x\<rbrakk> \<Longrightarrow> P y"
  shows "P v"
  using assms unfolding reachable_def by (rule rtrancl_on_induct) auto

lemma converse_reachable_induct[consumes 1, case_names base step, induct pred: reachable]:
  assumes major: "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
    and cases: "v \<in> verts G \<Longrightarrow> P v"
       "\<And>x y. \<lbrakk>x \<rightarrow>\<^bsub>G\<^esub> y; y \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v; P y\<rbrakk> \<Longrightarrow> P x"
  shows "P u"
  using assms unfolding reachable_def by (rule converse_rtrancl_on_induct) auto

lemma (in pre_digraph) converse_reachable_cases:
  assumes "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
  obtains (base) "u = v" "u \<in> verts G"
    | (step) w where "u \<rightarrow>\<^bsub>G\<^esub> w" "w \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
  using assms unfolding reachable_def by (cases rule: converse_rtrancl_on_cases) auto

lemma reachable_in_verts:
  assumes "u \<rightarrow>\<^sup>* v" shows "u \<in> verts G" "v \<in> verts G"
  using assms by induct (simp_all add: adj_in_verts)

lemma reachable1_in_verts:
  assumes "u \<rightarrow>\<^sup>+ v" shows "u \<in> verts G" "v \<in> verts G"
  using assms
  by induct (simp_all add: adj_in_verts)

lemma reachable1_reachable[intro]:
  "v \<rightarrow>\<^sup>+ w \<Longrightarrow> v \<rightarrow>\<^sup>* w"
  unfolding reachable_def
  by (rule rtrancl_consistent_rtrancl_on) (simp_all add: reachable1_in_verts adj_in_verts)

lemmas reachable1_reachableE[elim] = reachable1_reachable[elim_format]

lemma reachable_neq_reachable1[intro]:
  assumes reach: "v \<rightarrow>\<^sup>* w"
  and neq: "v \<noteq> w"
  shows "v \<rightarrow>\<^sup>+ w"
proof -
  from reach have "(v,w) \<in> (arcs_ends G)^*" by (rule reachable_rtranclI)
  with neq show ?thesis by (auto dest: rtranclD)
qed

lemmas reachable_neq_reachable1E[elim] = reachable_neq_reachable1[elim_format]

lemma reachable1_reachable_trans [trans]:
  "u \<rightarrow>\<^sup>+ v \<Longrightarrow> v \<rightarrow>\<^sup>* w \<Longrightarrow> u \<rightarrow>\<^sup>+ w"
by (metis trancl_trans reachable_neq_reachable1)

lemma reachable_reachable1_trans [trans]:
  "u \<rightarrow>\<^sup>* v \<Longrightarrow> v \<rightarrow>\<^sup>+ w \<Longrightarrow> u \<rightarrow>\<^sup>+ w"
by (metis trancl_trans reachable_neq_reachable1)

lemma reachable_conv:
  "u \<rightarrow>\<^sup>* v \<longleftrightarrow> (u,v) \<in> (arcs_ends G)^* \<inter> (verts G \<times> verts G)"
  apply (auto intro: reachable_in_verts)
  apply (induct rule: rtrancl_induct)
   apply auto
  done

lemma reachable_conv':
  assumes "u \<in> verts G"
  shows "u \<rightarrow>\<^sup>* v \<longleftrightarrow> (u,v) \<in> (arcs_ends G)\<^sup>*" (is "?L = ?R")
proof
  assume "?R" then show "?L" using assms  by induct auto
qed (auto simp: reachable_conv)

end

lemma (in sym_digraph) symmetric_reachable':
  assumes "v \<rightarrow>\<^sup>*\<^bsub>G\<^esub> w" shows "w \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v"
  using sym_arcs assms by (rule symmetric_reachable)

subsection \<open>Degrees of vertices\<close>

definition in_arcs :: "('a, 'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> 'b set" where
  "in_arcs G v \<equiv> {e \<in> arcs G. head G e = v}"

definition out_arcs :: "('a, 'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> 'b set" where
  "out_arcs G v \<equiv> {e \<in> arcs G. tail G e = v}"

definition in_degree :: "('a, 'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> nat" where
  "in_degree G v \<equiv> card (in_arcs G v)"

definition out_degree :: "('a, 'b) pre_digraph \<Rightarrow> 'a \<Rightarrow> nat" where
  "out_degree G v \<equiv> card (out_arcs G v)"

lemma (in fin_digraph) finite_in_arcs[intro]:
  "finite (in_arcs G v)"
  unfolding in_arcs_def by auto

lemma (in fin_digraph) finite_out_arcs[intro]:
  "finite (out_arcs G v)"
  unfolding out_arcs_def by auto

lemma in_in_arcs_conv[simp]:
  "e \<in> in_arcs G v \<longleftrightarrow> e \<in> arcs G \<and> head G e = v"
  unfolding in_arcs_def by auto

lemma in_out_arcs_conv[simp]:
  "e \<in> out_arcs G v \<longleftrightarrow> e \<in> arcs G \<and> tail G e = v"
  unfolding out_arcs_def by auto

lemma inout_arcs_arc_simps[simp]:
  assumes "e \<in> arcs G"
  shows "tail G e = u \<Longrightarrow> out_arcs G u \<inter> insert e E = insert e (out_arcs G u \<inter> E)"
        "tail G e \<noteq> u \<Longrightarrow> out_arcs G u \<inter> insert e E = out_arcs G u \<inter> E"
        "out_arcs G u \<inter> {} = {}" (* XXX: should be unnecessary *)
        "head G e = u \<Longrightarrow> in_arcs G u \<inter> insert e E = insert e (in_arcs G u \<inter> E)"
        "head G e \<noteq> u \<Longrightarrow> in_arcs G u \<inter> insert e E = in_arcs G u \<inter> E"
        "in_arcs G u \<inter> {} = {}" (* XXX: should be unnecessary *)
  using assms by auto

lemma in_arcs_int_arcs[simp]: "in_arcs G u \<inter> arcs G = in_arcs G u" and
      out_arcs_int_arcs[simp]: "out_arcs G u \<inter> arcs G = out_arcs G u"
  by auto

lemma in_arcs_in_arcs: "x \<in> in_arcs G u \<Longrightarrow> x \<in> arcs G"
  and out_arcs_in_arcs: "x \<in> out_arcs G u \<Longrightarrow> x \<in> arcs G"
  by (auto simp: in_arcs_def out_arcs_def)

subsection \<open>Graph operations\<close>

context pre_digraph begin

definition add_arc :: "'b \<Rightarrow>  ('a,'b) pre_digraph" where
  "add_arc a = \<lparr> verts = verts G \<union> {tail G a, head G a}, arcs = insert a (arcs G), tail = tail G, head = head G \<rparr>"

definition  del_arc :: "'b \<Rightarrow> ('a,'b) pre_digraph" where
  "del_arc a = \<lparr> verts = verts G, arcs = arcs G - {a}, tail = tail G, head = head G \<rparr>"

definition add_vert :: "'a \<Rightarrow>  ('a,'b) pre_digraph" where
  "add_vert v = \<lparr> verts = insert v (verts G), arcs = arcs G, tail = tail G, head = head G \<rparr>"

definition del_vert :: "'a \<Rightarrow>  ('a,'b) pre_digraph" where
  "del_vert v = \<lparr> verts = verts G - {v}, arcs = {a \<in> arcs G. tail G a \<noteq> v \<and> head G a \<noteq> v}, tail = tail G, head = head G \<rparr>"

lemma
  verts_add_arc: "\<lbrakk> tail G a \<in> verts G; head G a \<in> verts G \<rbrakk> \<Longrightarrow> verts (add_arc a) = verts G"  and
  verts_add_arc_conv: "verts (add_arc a) = verts G \<union> {tail G a, head G a}" and
  arcs_add_arc: "arcs (add_arc a) = insert a (arcs G)" and
  tail_add_arc: "tail (add_arc a) = tail G" and
  head_add_arc: "head (add_arc a) = head G"
  by (auto simp: add_arc_def)

lemmas add_arc_simps[simp] = verts_add_arc arcs_add_arc tail_add_arc head_add_arc

lemma
  verts_del_arc: "verts (del_arc a) = verts G"  and
  arcs_del_arc: "arcs (del_arc a) = arcs G - {a}" and
  tail_del_arc: "tail (del_arc a) = tail G" and
  head_del_arc: "head (del_arc a) = head G"
  by (auto simp: del_arc_def)

lemmas del_arc_simps[simp] = verts_del_arc arcs_del_arc tail_del_arc head_del_arc

lemma
    verts_add_vert: "verts (pre_digraph.add_vert G u) = insert u (verts G)" and
    arcs_add_vert: "arcs (pre_digraph.add_vert G u) = arcs G" and
    tail_add_vert: "tail (pre_digraph.add_vert G u) = tail G" and
    head_add_vert: "head (pre_digraph.add_vert G u) = head G"
  by (auto simp: pre_digraph.add_vert_def)

lemmas add_vert_simps = verts_add_vert arcs_add_vert tail_add_vert head_add_vert

lemma
    verts_del_vert: "verts (pre_digraph.del_vert G u) = verts G - {u}" and
    arcs_del_vert: "arcs (pre_digraph.del_vert G u) = {a \<in> arcs G. tail G a \<noteq> u \<and> head G a \<noteq> u}" and
    tail_del_vert: "tail (pre_digraph.del_vert G u) = tail G" and
    head_del_vert: "head (pre_digraph.del_vert G u) = head G" and
    ends_del_vert: "arc_to_ends (pre_digraph.del_vert G u) = arc_to_ends G"
  by (auto simp: pre_digraph.del_vert_def arc_to_ends_def)

lemmas del_vert_simps = verts_del_vert arcs_del_vert tail_del_vert head_del_vert

lemma add_add_arc_collapse[simp]: "pre_digraph.add_arc (add_arc a) a = add_arc a"
  by (auto simp: pre_digraph.add_arc_def)

lemma add_del_arc_collapse[simp]: "pre_digraph.add_arc (del_arc a) a = add_arc a"
  by (auto simp: pre_digraph.verts_add_arc_conv pre_digraph.add_arc_simps)

lemma del_add_arc_collapse[simp]:
  "\<lbrakk> tail G a \<in> verts G; head G a \<in> verts G \<rbrakk> \<Longrightarrow> pre_digraph.del_arc (add_arc a) a = del_arc a"
  by (auto simp: pre_digraph.add_arc_simps pre_digraph.del_arc_simps)

lemma del_del_arc_collapse[simp]: "pre_digraph.del_arc (del_arc a) a = del_arc a"
  by (auto simp: pre_digraph.add_arc_simps pre_digraph.del_arc_simps)

lemma add_arc_commute: "pre_digraph.add_arc (add_arc b) a = pre_digraph.add_arc (add_arc a) b"
  by (auto simp: pre_digraph.add_arc_def)

lemma del_arc_commute: "pre_digraph.del_arc (del_arc b) a = pre_digraph.del_arc (del_arc a) b"
  by (auto simp: pre_digraph.del_arc_def)

lemma del_arc_in: "a \<notin> arcs G \<Longrightarrow> del_arc a = G"
  by (rule pre_digraph.equality) (auto simp: add_arc_def)

lemma in_arcs_add_arc_iff:
  "in_arcs (add_arc a) u = (if head G a = u then insert a (in_arcs G u) else in_arcs G u)"
  by auto

lemma out_arcs_add_arc_iff:
  "out_arcs (add_arc a) u = (if tail G a = u then insert a (out_arcs G u) else out_arcs G u)"
  by auto

lemma in_arcs_del_arc_iff:
  "in_arcs (del_arc a) u = (if head G a = u then in_arcs G u - {a} else in_arcs G u)"
  by auto

lemma out_arcs_del_arc_iff:
  "out_arcs (del_arc a) u = (if tail G a = u then out_arcs G u - {a} else out_arcs G u)"
  by auto

lemma (in wf_digraph) add_arc_in: "a \<in> arcs G \<Longrightarrow> add_arc a = G"
  by (rule pre_digraph.equality) (auto simp: add_arc_def)

end

context wf_digraph begin

lemma wf_digraph_add_arc[intro]:
  "wf_digraph (add_arc a)" by unfold_locales (auto simp: verts_add_arc_conv)

lemma wf_digraph_del_arc[intro]:
  "wf_digraph (del_arc a)" by unfold_locales (auto simp: verts_add_arc_conv)

lemma wf_digraph_del_vert: "wf_digraph (del_vert u)"
  by standard (auto simp: del_vert_simps)

lemma wf_digraph_add_vert: "wf_digraph (add_vert u)"
  by standard (auto simp: add_vert_simps)

lemma del_vert_add_vert:
  assumes "u \<notin> verts G"
  shows "pre_digraph.del_vert (add_vert u) u = G"
  using assms by (intro pre_digraph.equality) (auto simp: pre_digraph.del_vert_def add_vert_def)

end

context fin_digraph begin

lemma in_degree_add_arc_iff:
  "in_degree (add_arc a) u = (if head G a = u \<and> a \<notin> arcs G then in_degree G u + 1 else in_degree G u)"
proof -
  have "a \<notin> arcs G \<Longrightarrow> a \<notin> in_arcs G u" by (auto simp: in_arcs_def)
  with finite_in_arcs show ?thesis
    unfolding in_degree_def by (auto simp: in_arcs_add_arc_iff intro: arg_cong[where f=card])
qed

lemma out_degree_add_arc_iff:
  "out_degree (add_arc a) u = (if tail G a = u \<and> a \<notin> arcs G then out_degree G u + 1 else out_degree G u)"
proof -
  have "a \<notin> arcs G \<Longrightarrow> a \<notin> out_arcs G u" by (auto simp: out_arcs_def)
  with finite_out_arcs show ?thesis
    unfolding out_degree_def by (auto simp: out_arcs_add_arc_iff intro: arg_cong[where f=card])
qed

lemma in_degree_del_arc_iff:
  "in_degree (del_arc a) u = (if head G a = u \<and> a \<in> arcs G then in_degree G u - 1 else in_degree G u)"
proof -
  have "a \<notin> arcs G \<Longrightarrow> a \<notin> in_arcs G u" by (auto simp: in_arcs_def)
  with finite_in_arcs show ?thesis
    unfolding in_degree_def by (auto simp: in_arcs_del_arc_iff intro: arg_cong[where f=card])
qed

lemma out_degree_del_arc_iff:
  "out_degree (del_arc a) u = (if tail G a = u \<and> a \<in> arcs G then out_degree G u - 1 else out_degree G u)"
proof -
  have "a \<notin> arcs G \<Longrightarrow> a \<notin> out_arcs G u" by (auto simp: out_arcs_def)
  with finite_out_arcs show ?thesis
    unfolding out_degree_def by (auto simp: out_arcs_del_arc_iff intro: arg_cong[where f=card])
qed

lemma fin_digraph_del_vert: "fin_digraph (del_vert u)"
  by standard (auto simp: del_vert_simps)

lemma fin_digraph_del_arc: "fin_digraph (del_arc a)"
  by standard (auto simp: del_vert_simps)

end

end


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

section \<open>Subadditive and submultiplicative sequences\<close>

theory Fekete
  imports "HOL-Analysis.Multivariate_Analysis"
begin

text \<open>A real sequence is subadditive if $u_{n+m} \leq u_n+u_m$. This implies the
convergence of $u_n/n$ to $Inf\{u_n/n\} \in [-\infty, +\infty)$, a useful result known
as Fekete lemma. We prove it below.

Taking logarithms, the same result applies to submultiplicative sequences. We illustrate
it with the definition of the spectral radius as the limit of $\|x^n\|^{1/n}$, the
convergence following from Fekete lemma.\<close>

subsection \<open>Subadditive sequences\<close>

text \<open>We define subadditive sequences, either from the start or eventually.\<close>

definition subadditive::"(nat\<Rightarrow>real) \<Rightarrow> bool"
  where "subadditive u = (\<forall>m n. u (m+n) \<le> u m + u n)"

lemma subadditiveI:
  assumes "\<And>m n. u (m+n) \<le> u m + u n"
  shows "subadditive u"
unfolding subadditive_def using assms by auto

lemma subadditiveD:
  assumes "subadditive u"
  shows "u (m+n) \<le> u m + u n"
using assms unfolding subadditive_def by auto

lemma subadditive_un_le_nu1:
  assumes "subadditive u"
          "n > 0"
  shows "u n \<le> n * u 1"
proof -
  have *: "n = 0 \<or> (u n \<le> n * u 1)" for n
  proof (induction n)
    case 0
    then show ?case by auto
  next
    case (Suc n)
    consider "n = 0" | "n > 0" by auto
    then show ?case
    proof (cases)
      case 1
      then show ?thesis by auto
    next
      case 2
      then have "u (Suc n) \<le> u n + u 1" using subadditiveD[OF assms(1), of n 1] by auto
      then show ?thesis using Suc.IH 2 by (auto simp add: algebra_simps)
    qed
  qed
  show ?thesis using *[of n] \<open>n > 0\<close> by auto
qed

definition eventually_subadditive::"(nat\<Rightarrow>real) \<Rightarrow> nat \<Rightarrow> bool"
  where "eventually_subadditive u N0 = (\<forall>m>N0. \<forall>n>N0. u (m+n) \<le> u m + u n)"

lemma eventually_subadditiveI:
  assumes "\<And>m n. m > N0 \<Longrightarrow> n > N0 \<Longrightarrow> u (m+n) \<le> u m + u n"
  shows "eventually_subadditive u N0"
unfolding eventually_subadditive_def using assms by auto

lemma subadditive_imp_eventually_subadditive:
  assumes "subadditive u"
  shows "eventually_subadditive u 0"
using assms unfolding subadditive_def eventually_subadditive_def by auto

text \<open>The main inequality that will lead to convergence is given in the next lemma:
given $n$, then eventually $u_m/m$ is bounded by $u_n/n$, up to an arbitrarily small error.
This is proved by doing the euclidean division of $m$ by $n$ and using the subadditivity.
(the remainder in the euclidean division will give the error term.)\<close>

lemma eventually_subadditive_ineq:
  assumes "eventually_subadditive u N0" "e>0" "n>N0"
  shows "\<exists>N>N0. \<forall>m\<ge>N. u m/m < u n/n + e"
proof -
  have ineq_rec: "u(a*n+r) \<le> a * u n + u r" if "n>N0" "r>N0" for a n r
  proof (induct a)
    case (Suc a)
    have "a*n+r>N0" using \<open>r>N0\<close> by simp
    have "u((Suc a)*n+r) = u(a*n+r+n)" by (simp add: algebra_simps)
    also have "... \<le> u(a*n+r)+u n" using assms \<open>n>N0\<close> \<open>a*n+r>N0\<close> eventually_subadditive_def by blast
    also have "... \<le> a*u n + u r + u n" by (simp add: Suc.hyps)
    also have "... = (Suc a) * u n + u r" by (simp add: algebra_simps)
    finally show ?case by simp
  qed (simp)

  have "n>0" "real n > 0" using \<open>n>N0\<close> by auto
  define C where "C = Max {abs(u i) |i. i\<le>2*n}"
  have ineq_C: "abs(u i) \<le> C" if "i \<le> 2 * n" for i
    unfolding C_def by (intro Max_ge, auto simp add: that)

  have ineq_all_m: "u m/m \<le> u n/n + 3*C/m" if "m\<ge>n" for m
  proof -
    have "real m>0" using \<open>m\<ge>n\<close> \<open>0 < real n\<close> by linarith

    obtain a0 r0 where "r0<n" "m = a0*n+r0"
      using \<open>0 < n\<close> mod_div_decomp mod_less_divisor by blast
    define a where "a = a0-1"
    define r where "r = r0+n"
    have "r<2*n" "r\<ge>n" unfolding r_def by (auto simp add: \<open>r0<n\<close>)
    have "a0>0" using \<open>m = a0*n + r0\<close> \<open>n \<le> m\<close> \<open>r0 < n\<close> not_le by fastforce
    then have "m = a * n + r" using a_def r_def \<open>m = a0*n+r0\<close> mult_eq_if by auto
    then have real_eq: "-r = real n * a - m" by simp

    have "r>N0" using \<open>r\<ge>n\<close> \<open>n>N0\<close> by simp
    then have "u m \<le> a * u n + u r" using ineq_rec \<open>m = a*n+r\<close> \<open>n>N0\<close> by simp
    then have "n * u m \<le> n * (a * u n + u r)" using \<open>real n>0\<close> by simp
    then have "n * u m - m * u n \<le> -r * u n + n * u r"
      unfolding real_eq by (simp add: algebra_simps)
    also have "... \<le> r * abs(u n) + n * abs(u r)"
      apply (intro add_mono mult_left_mono) using real_0_le_add_iff by fastforce+
    also have "... \<le> (2 * n) * C + n * C"
      apply (intro add_mono mult_mono ineq_C) using less_imp_le[OF \<open>r < 2 * n\<close>] by auto
    finally have "n * u m - m * u n \<le> 3*C*n" by auto
    then show "u m/m \<le> u n/n + 3*C/m"
      using \<open>0 < real n\<close> \<open>0 < real m\<close> by (simp add: divide_simps mult.commute)
  qed

  obtain M::nat where M: "M \<ge> 3 * C / e" using real_nat_ceiling_ge by auto
  define N where "N = M + n + N0 + 1"
  have "N > 3 * C / e" "N \<ge> n" "N > N0" unfolding N_def using M by auto
  have "u m/m < u n/n + e" if "m \<ge> N" for m
  proof -
    have "3 * C / m < e"
      using that \<open>N > 3 * C / e\<close> \<open>e > 0\<close> apply (auto simp add: algebra_simps divide_simps)
      by (meson le_less_trans linorder_not_le mult_less_cancel_left_pos of_nat_less_iff)
    then show ?thesis using ineq_all_m[of m] \<open>n \<le> N\<close> \<open>N \<le> m\<close> by auto
  qed
  then show ?thesis using \<open>N0 < N\<close> by blast
qed

text \<open>From the inequality above, we deduce the convergence of $u_n/n$ to its infimum. As this
infimum might be $-\infty$, we formulate this convergence in the extended reals. Then, we
specialize it to the real situation, separating the cases where $u_n/n$ is bounded below or not.\<close>

lemma subadditive_converges_ereal':
  assumes "eventually_subadditive u N0"
  shows "(\<lambda>m. ereal(u m/m)) \<longlonglongrightarrow> Inf {ereal(u n/n) | n. n>N0}"
proof -
  define v where "v = (\<lambda>m. ereal(u m/m))"
  define V where "V = {v n | n. n>N0}"
  define l where "l = Inf V"

  have "\<And>t. t\<in>V \<Longrightarrow> t\<ge>l" by (simp add: Inf_lower l_def)
  then have "v n \<ge> l" if "n > N0" for n using V_def that by blast
  then have lower: "eventually (\<lambda>n. a < v n) sequentially" if "a < l" for a
    by (meson that dual_order.strict_trans1 eventually_at_top_dense)

  have upper: "eventually (\<lambda>n. a > v n) sequentially" if "a > l" for a
  proof -
    obtain t where "t\<in>V" "t<a" by (metis \<open>a>l\<close> Inf_greatest l_def not_le)
    then obtain e::real where "e>0" "t+e < a" by (meson ereal_le_epsilon2 leD le_less_linear)
    obtain n where "n>N0" "t = u n/n" using V_def v_def \<open>t \<in> V\<close> by blast
    then have "u n/n + e < a" using \<open>t+e < a\<close> by simp
    obtain N where "\<forall>m\<ge>N. u m/m < u n/n + e"
      using eventually_subadditive_ineq[OF assms] \<open>0 < e\<close> \<open>N0 < n\<close> by blast
    then have "u m/m < a" if "m \<ge> N" for m
      using that \<open>u n/n + e < a\<close> less_ereal.simps(1) less_trans by blast
    then have "v m< a" if "m \<ge> N" for m using v_def that by blast
    then show ?thesis using eventually_at_top_linorder by auto
  qed
  show ?thesis
    using lower upper unfolding V_def l_def v_def by (simp add: order_tendsto_iff)
qed

lemma subadditive_converges_ereal:
  assumes "subadditive u"
  shows "(\<lambda>m. ereal(u m/m)) \<longlonglongrightarrow> Inf {ereal(u n/n) | n. n>0}"
by (rule subadditive_converges_ereal'[OF subadditive_imp_eventually_subadditive[OF assms]])

lemma subadditive_converges_bounded':
  assumes "eventually_subadditive u N0"
          "bdd_below {u n/n | n. n>N0}"
  shows "(\<lambda>n. u n/n) \<longlonglongrightarrow> Inf {u n/n | n. n>N0}"
proof-
  have *: "(\<lambda>n. ereal(u n /n)) \<longlonglongrightarrow> Inf {ereal(u n/n)|n. n > N0}"
    by (simp add: assms(1) subadditive_converges_ereal')
  define V where "V = {u n/n | n. n>N0}"
  have a: "bdd_below V" "V\<noteq>{}" by (auto simp add: V_def assms(2))
  have "Inf {ereal(t)| t. t\<in>V} = ereal(Inf V)" by (subst ereal_Inf'[OF a], simp add: Setcompr_eq_image)
  moreover have "{ereal(t)| t. t\<in>V} = {ereal(u n/n)|n. n > N0}" using V_def by blast
  ultimately have "Inf {ereal(u n/n)|n. n > N0} = ereal(Inf {u n/n |n. n > N0})" using V_def by auto
  then have "(\<lambda>n. ereal(u n /n)) \<longlonglongrightarrow> ereal(Inf {u n/n | n. n>N0})" using * by auto
  then show ?thesis by simp
qed

lemma subadditive_converges_bounded:
  assumes "subadditive u"
          "bdd_below {u n/n | n. n>0}"
  shows "(\<lambda>n. u n/n) \<longlonglongrightarrow> Inf {u n/n | n. n>0}"
by (rule subadditive_converges_bounded'[OF subadditive_imp_eventually_subadditive[OF assms(1)] assms(2)])

text \<open>We reformulate the previous lemma in a more directly usable form, avoiding the infimum.\<close>

lemma subadditive_converges_bounded'':
  assumes "subadditive u"
          "\<And>n. n > 0 \<Longrightarrow> u n \<ge> n * (a::real)"
  shows "\<exists>l. (\<lambda>n. u n / n) \<longlonglongrightarrow> l \<and> (\<forall>n>0. u n \<ge> n * l)"
proof -
  have B: "bdd_below {u n/n | n. n>0}"
    apply (rule bdd_belowI[of _ a]) using assms(2)
    apply (auto simp add: divide_simps)
    apply (metis mult.commute mult_left_le_imp_le of_nat_0_less_iff)
    done
  define l where "l = Inf {u n/n | n. n>0}"
  have *: "u n / n \<ge> l" if "n > 0" for n
    unfolding l_def using that by (auto intro!: cInf_lower[OF _ B])
  show ?thesis
    apply (rule exI[of _ l], auto)
    using subadditive_converges_bounded[OF assms(1) B] apply (simp add: l_def)
    using * by (simp add: divide_simps algebra_simps)
qed

lemma subadditive_converges_unbounded':
  assumes "eventually_subadditive u N0"
          "\<not> (bdd_below {u n/n | n. n>N0})"
  shows "(\<lambda>n. ereal(u n/n)) \<longlonglongrightarrow> -\<infinity>"
proof -
  have *: "(\<lambda>n. ereal(u n /n)) \<longlonglongrightarrow> Inf {ereal(u n/n)|n. n > N0}"
    by (simp add: assms(1) subadditive_converges_ereal')
  define V where "V = {u n/n | n. n>N0}"
  then have "\<not> bdd_below V" using assms by simp
  have "Inf {ereal(t) | t. t\<in>V} = -\<infinity>"
    by (rule ereal_bot, metis (mono_tags, lifting) \<open>\<not> bdd_below V\<close> bdd_below_def
        leI Inf_lower2 ereal_less_eq(3) le_less mem_Collect_eq)
  moreover have "{ereal(t)| t. t\<in>V} = {ereal(u n/n)|n. n > N0}" using V_def by blast
  ultimately have "Inf {ereal(u n/n)|n. n > N0} = -\<infinity>" by auto
  then show ?thesis using * by simp
qed

lemma subadditive_converges_unbounded:
  assumes "subadditive u"
          "\<not> (bdd_below {u n/n | n. n>0})"
  shows "(\<lambda>n. ereal(u n/n)) \<longlonglongrightarrow> -\<infinity>"
by (rule subadditive_converges_unbounded'[OF subadditive_imp_eventually_subadditive[OF assms(1)] assms(2)])

subsection \<open>Superadditive sequences\<close>

text \<open>While most applications involve subadditive sequences, one sometimes encounters superadditive
sequences. We reformulate quickly some of the above results in this setting.\<close>

definition superadditive::"(nat\<Rightarrow>real) \<Rightarrow> bool"
  where "superadditive u = (\<forall>m n. u (m+n) \<ge> u m + u n)"

lemma superadditive_un_ge_nu1:
  assumes "superadditive u"
          "n > 0"
  shows "u n \<ge> n * u 1"
using subadditive_un_le_nu1[OF subadditive_of_superadditive[OF assms(1)] assms(2)] by auto

lemma superadditive_converges_bounded'':
  assumes "superadditive u"
          "\<And>n. n > 0 \<Longrightarrow> u n \<le> n * (a::real)"
  shows "\<exists>l. (\<lambda>n. u n / n) \<longlonglongrightarrow> l \<and> (\<forall>n>0. u n \<le> n * l)"
proof -
  have "\<exists>l. (\<lambda>n. -u n / n) \<longlonglongrightarrow> l \<and> (\<forall>n>0. -u n \<ge> n * l)"
    apply (rule subadditive_converges_bounded''[OF subadditive_of_superadditive[OF assms(1)], of "-a"])
    using assms(2) by auto
  then obtain l where l: "(\<lambda>n. -u n / n) \<longlonglongrightarrow> l" "(\<forall>n>0. -u n \<ge> n * l)" by blast
  have "(\<lambda>n. -((-u n)/n)) \<longlonglongrightarrow> -l"
    by (intro tendsto_intros l)
  moreover have "\<forall>n>0. u n \<le> n * (-l)"
    using l(2) by (auto simp add: algebra_simps) (metis minus_equation_iff neg_le_iff_le)
  ultimately show ?thesis
    by auto
qed

subsection \<open>Almost additive sequences\<close>

text \<open>One often encounters sequences which are both subadditive and superadditive, but only up
to an additive constant. Adding or subtracting this constant, one can make the sequence
genuinely subadditive or superadditive, and thus deduce results about its convergence, as follows.
Such sequences appear notably when dealing with quasimorphisms.\<close>

lemma almost_additive_converges:
  fixes u::"nat \<Rightarrow> real"
  assumes "\<And>m n. abs(u(m+n) - u m - u n) \<le> C"
  shows "convergent (\<lambda>n. u n/n)"
        "abs(u k - k * lim (\<lambda>n. u n / n)) \<le> C"
proof -
  have "(abs (u 0)) \<le> C" using assms[of 0 0] by auto
  then have "C \<ge> 0" by auto

  define v where "v = (\<lambda>n. u n + C)"
  have "subadditive v"
    unfolding subadditive_def v_def using assms by (auto simp add: algebra_simps abs_diff_le_iff)
  then have vle: "v n \<le> n * v 1" if "n > 0" for n
    using subadditive_un_le_nu1 that by auto
  define w where "w = (\<lambda>n. u n - C)"
  have "superadditive w"
    unfolding superadditive_def w_def using assms by (auto simp add: algebra_simps abs_diff_le_iff)
  then have wge: "w n \<ge> n * w 1" if "n > 0" for n
    using superadditive_un_ge_nu1 that by auto

  have I: "v n \<ge> w n" for n
    unfolding v_def w_def using \<open>C \<ge> 0\<close> by auto
  then have *: "v n \<ge> n * w 1" if "n > 0" for n using order_trans[OF wge[OF that]] by auto
  then obtain lv where lv: "(\<lambda>n. v n/n) \<longlonglongrightarrow> lv" "\<And>n. n > 0 \<Longrightarrow> v n \<ge> n * lv"
    using subadditive_converges_bounded''[OF \<open>subadditive v\<close> *] by auto
  have *: "w n \<le> n * v 1" if "n > 0" for n using order_trans[OF _ vle[OF that]] I by auto
  then obtain lw where lw: "(\<lambda>n. w n/n) \<longlonglongrightarrow> lw" "\<And>n. n > 0 \<Longrightarrow> w n \<le> n * lw"
    using superadditive_converges_bounded''[OF \<open>superadditive w\<close> *] by auto

  have *: "v n/n = w n /n + 2*C*(1/n)" for n
    unfolding v_def w_def by (auto simp add: algebra_simps divide_simps)
  have "(\<lambda>n. w n /n + 2*C*(1/n)) \<longlonglongrightarrow> lw + 2*C*0"
    by (intro tendsto_add tendsto_mult lim_1_over_n lw, auto)
  then have "lw = lv"
    unfolding *[symmetric] using lv(1) LIMSEQ_unique by auto

  have *: "u n/n = w n /n + C*(1/n)" for n
    unfolding w_def by (auto simp add: algebra_simps divide_simps)
  have "(\<lambda>n. u n /n) \<longlonglongrightarrow> lw + C*0"
    unfolding * by (intro tendsto_add tendsto_mult lim_1_over_n lw, auto)
  then have lu: "convergent (\<lambda>n. u n/n)" "lim (\<lambda>n. u n/n) = lw"
    by (auto simp add: convergentI limI)
  then show "convergent (\<lambda>n. u n/n)" by simp

  show "abs(u k - k * lim (\<lambda>n. u n / n)) \<le> C"
  proof (cases "k>0")
    case False
    then show ?thesis using assms[of 0 0] by auto
  next
    case True
    have "u k - k * lim (\<lambda>n. u n/n) = v k - C - k * lv" unfolding lu(2) \<open>lw = lv\<close> v_def by auto
    also have "... \<ge> -C" using lv(2)[OF True] by auto
    finally have A: "u k - k * lim (\<lambda>n. u n/n) \<ge> - C" by simp
    have "u k - k * lim (\<lambda>n. u n/n) = w k + C - k * lw" unfolding lu(2) w_def by auto
    also have "... \<le> C" using lw(2)[OF True] by auto
    finally show ?thesis using A by auto
  qed
qed

subsection \<open>Submultiplicative sequences, application to the spectral radius\<close>

text \<open>In the same way as subadditive sequences, one may define submultiplicative sequences.
Essentially, a sequence is submultiplicative if its logarithm is subadditive. A difference is
that we allow a submultiplicative sequence to take the value $0$, as this shows up in applications.
This implies that we have to distinguish in the proofs the situations where the value $0$
is taken or not. In the latter situation, we can use directly the results from the
subadditive case to deduce convergence. In the former situation, convergence to $0$ is obvious
as the sequence vanishes eventually.\<close>

lemma submultiplicative_converges:
  fixes u::"nat\<Rightarrow>real"
  assumes "\<And>n. u n \<ge> 0"
          "\<And>m n. u (m+n) \<le> u m * u n"
  shows "(\<lambda>n. root n (u n))\<longlonglongrightarrow> Inf {root n (u n) | n. n>0}"
proof -
  define v where "v = (\<lambda> n. root n (u n))"
  define V where "V = {v n | n. n>0}"
  then have "V \<noteq> {}" by blast
  have "t \<ge> 0" if "t \<in> V" for t using that V_def v_def assms(1) by auto
  then have "Inf V \<ge> 0" by (simp add: \<open>V \<noteq> {}\<close> cInf_greatest)
  have "bdd_below V" by (meson \<open>\<And>t. t \<in> V \<Longrightarrow> 0 \<le> t\<close> bdd_below_def)

  show ?thesis
  proof cases
    assume "\<exists>n. u n = 0"
    then obtain n where "u n = 0" by auto
    then have "u m = 0" if "m \<ge> n" for m by (metis that antisym_conv assms(1) assms(2) le_Suc_ex mult_zero_left)
    then have *: "v m = 0" if "m \<ge> n" for m using v_def that by simp
    then have "v \<longlonglongrightarrow> 0" using lim_explicit by force

    have "v (Suc n) \<in> V" using V_def by blast
    moreover have "v (Suc n) = 0" using * by auto
    ultimately have "Inf V \<le> 0" by (simp add: \<open>bdd_below V\<close> cInf_lower)
    then have "Inf V = 0" using \<open>0 \<le> Inf V\<close> by auto
    then show ?thesis using V_def v_def \<open>v \<longlonglongrightarrow> 0\<close> by auto
  next
    assume "\<not> (\<exists>n. u n = 0)"
    then have "u n > 0" for n by (metis assms(1) less_eq_real_def)
    define w where "w n = ln (u n)" for n
    have express_vn: "v n = exp(w n/n)" if "n>0" for n
    proof -
      have "(exp(w n/n))^n = exp(n*(w n/n))" by (metis exp_of_nat_mult)
      also have "... = exp(w n)" by (simp add: \<open>0 < n\<close>)
      also have "... = u n" by (simp add: \<open>\<And>n. 0 < u n\<close> w_def)
      finally have "exp(w n/n) = root n (u n)" by (metis \<open>0 < n\<close> exp_ge_zero real_root_power_cancel)
      then show ?thesis unfolding v_def by simp
    qed

    have "eventually_subadditive w 0"
    proof (rule eventually_subadditiveI)
      fix m n
      have "w (m+n) = ln (u (m+n))" by (simp add: w_def)
      also have "... \<le> ln(u m * u n)"
        by (meson \<open>\<And>n. 0 < u n\<close> assms(2) zero_less_mult_iff ln_le_cancel_iff)
      also have "... = ln(u m) + ln(u n)" by (simp add: \<open>\<And>n. 0 < u n\<close> ln_mult)
      also have "... = w m + w n" by (simp add: w_def)
      finally show "w (m+n) \<le> w m + w n".
    qed

    define l where "l = Inf V"
    then have "v n\<ge>l" if "n > 0" for n
      using V_def that by (metis (mono_tags, lifting) \<open>bdd_below V\<close> cInf_lower mem_Collect_eq)
    then have lower: "eventually (\<lambda>n. a < v n) sequentially" if "a < l" for a
      by (meson that dual_order.strict_trans1 eventually_at_top_dense)

    have upper: "eventually (\<lambda>n. a > v n) sequentially" if "a > l" for a
    proof -
      obtain t where "t\<in>V" "t < a" using \<open>V \<noteq> {}\<close> cInf_lessD l_def \<open>a>l\<close> by blast
      then have "t > 0" using V_def \<open>\<And>n. 0 < u n\<close> v_def by auto
      then have "a/t > 1" using \<open>t<a\<close> by simp
      define e where "e = ln(a/t)/2"
      have "e > 0" "e < ln(a/t)" unfolding e_def by (simp_all add: \<open>1 < a / t\<close> ln_gt_zero)
      then have "exp(e) < a/t" by (metis \<open>1 < a / t\<close> exp_less_cancel_iff exp_ln less_trans zero_less_one)

      obtain n where "n>0" "t = v n" using V_def v_def \<open>t \<in> V\<close> by blast
      with \<open>0 < t\<close> have "v n * exp(e) < a" using \<open>exp(e) < a/t\<close>
        by (auto simp add: field_simps)

      obtain N where *: "N>0" "\<And>m. m\<ge>N \<Longrightarrow> w m/m < w n/n + e"
        using eventually_subadditive_ineq[OF \<open>eventually_subadditive w 0\<close>] \<open>0 < n\<close> \<open>e>0\<close> by blast
      have "v m < a" if "m \<ge> N" for m
      proof -
        have "m>0" using that \<open>N>0\<close> by simp
        have "w m/m < w n/n + e" by (simp add: \<open>N \<le> m\<close> *)
        then have "exp(w m/m) < exp(w n/n + e)" by simp
        also have "... = exp(w n/n) * exp(e)" by (simp add: mult_exp_exp)
        finally have "v m < v n * exp(e)" using express_vn \<open>m>0\<close> \<open>n>0\<close> by simp
        then show "v m < a" using \<open>v n * exp(e) < a\<close> by simp
      qed
      then show ?thesis using eventually_at_top_linorder by auto
    qed

    show ?thesis
      using lower upper unfolding v_def l_def V_def by (simp add: order_tendsto_iff)
  qed
qed

text \<open>An important application of submultiplicativity is to prove the existence of the
spectral radius of a matrix, as the limit of $\|A^n\|^{1/n}$.\<close>

definition spectral_radius::"'a::real_normed_algebra_1 \<Rightarrow> real"
  where "spectral_radius x = Inf {root n (norm(x^n))| n. n>0}"

lemma spectral_radius_aux:
  fixes x::"'a::real_normed_algebra_1"
  defines "V \<equiv> {root n (norm(x^n))| n. n>0}"
  shows "\<And>t. t\<in>V \<Longrightarrow> t \<ge> spectral_radius x"
        "\<And>t. t\<in>V \<Longrightarrow> t \<ge> 0"
        "bdd_below V"
        "V \<noteq> {}"
        "Inf V \<ge> 0"
proof -
  show "V\<noteq>{}" using V_def by blast
  show *: "t \<ge> 0" if "t \<in> V" for t using that unfolding V_def using real_root_pos_pos_le by auto
  then show "bdd_below V" by (meson bdd_below_def)
  then show "Inf V \<ge> 0" by (simp add: \<open>V \<noteq> {}\<close> * cInf_greatest)
  show "\<And>t. t\<in>V \<Longrightarrow> t \<ge> spectral_radius x" by (metis (mono_tags, lifting) \<open>bdd_below V\<close> assms cInf_lower spectral_radius_def)
qed

lemma spectral_radius_nonneg [simp]:
  "spectral_radius x \<ge> 0"
by (simp add: spectral_radius_aux(5) spectral_radius_def)

lemma spectral_radius_upper_bound [simp]:
  "(spectral_radius x)^n \<le> norm(x^n)"
proof (cases)
  assume "\<not>(n = 0)"
  have "root n (norm(x^n)) \<ge> spectral_radius x"
    using spectral_radius_aux \<open>n \<noteq> 0\<close> by auto
  then show ?thesis
    by (metis \<open>n \<noteq> 0\<close> spectral_radius_nonneg norm_ge_zero not_gr0 power_mono real_root_pow_pos2)
qed (simp)

lemma spectral_radius_limit:
  "(\<lambda>n. root n (norm(x^n))) \<longlonglongrightarrow> spectral_radius x"
proof -
  have "norm(x^(m+n)) \<le> norm(x^m) * norm(x^n)" for m n by (simp add: power_add norm_mult_ineq)
  then show ?thesis unfolding spectral_radius_def using submultiplicative_converges by auto
qed

end (*of Fekete.thy*)


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_24
  imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun even :: "Nat => bool" where
  "even (Z) = True"
| "even (S (Z)) = False"
| "even (S (S z)) = even z"

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

theorem property0 :
  "((even (t2 x y)) = (even (t2 y x)))"
  oops

end