(*  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_field_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_field_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 simp: )
     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


(*header {* $\AA$: the logic of All p are q --- Section2.thy*}*)

theory Section2
imports Main "~~/src/HOL/Library/Order_Relation"

begin

subsection {* Syntax and Semantics --- Types and Definitions in Isabelle *}

text {* In this section we are going to formalize the proofs of Section 2 of the Lecture Notes.
Therefore, we need to find a datatype of formulas of the kind
\pftext{All p are q} and in order to do this we even need to first define a datatype of atomic
propositions \pf{p,q,\ldots}. After we have done this, we can define the semantics of such formulas
in a model, we can implement the derivability relation and proof soundness and completeness.*}

text {*  The set of atomic propositions is formalized as a
  type.\footnote{ See \cite[p.173]{tutorial:isabellehol} for further explanations
  on \texttt{typedecl}.}
  % actually lots of questions when looking at p.119
  Roughly speaking types are sets as known from set theory,
  but there are some differences. Making good use of types is one of
  the things one has to learn using Isabelle/HOL. For example,
  formalizing atomic proposition as a type imposes a constraint
  on the set of propositions:

\specialbox{Types in Isabelle are non-empty.}

*}

typedecl atProp

text {* Next we use the \pf{\bf datatype} declaration to define formulas.
  \pftext{All} is called a constructor, which can be considered as
  a function that takes two arguments of type \pftext{atProp} and produces
  an element of type \pftext{formula}. The addition \pftext{\ep{All \_ are \_ }}
  is optional,
  but allows us to write, as in the   lecture notes,
  \pf{All p are q} instead of \pf{All p q}. *}

datatype formula = All atProp atProp ("All _ are _ ")
(* (* print theorems screws up (to some extent) the document preparation *)
print_theorems
*)

text {*  Inductively defined sets are best formalized using the datatype
  declaration, for example, because Isabelle then provides inbuilt
  support for induction. The \pf{\bf print-theorems} command is not necessary,
  but if you move your mouse over it in Isabelle you can see
  which theorems you get for free by using the datatype declaration.
  For example
{\footnotesize
\begin{verbatim}
  formula.eq.simps:
    equal_class.equal All ?atProp1 are ?atProp2 All ?atProp1' are ?atProp2'
    \<equiv> ?atProp1 = ?atProp1' \<and> ?atProp2 = ?atProp2'
\end{verbatim}
}
says that two formulas are equal iff their respective atomic propositions are
equal.\footnote{See \cite[Section 8.5.2]{tutorial:isabellehol}
(and in particular p.176) and
\cite[Section 2.4]{tutorial:datatypes} for more details.} *}

text {*  The next definition describes models over a carrier as models parametric
  in an an aribrary (non-empty) type
  called \pftext{\primea}. The arrow \pftext{$\Rightarrow$} and \pftext{set} are
  type constructors, where \pftext{set} is the type
  of all subsets of \pftext{\primea} and \pftext{$\Rightarrow$}
  constructs the type of all
  set-theoretic functions. To summarize, a model over \pf{\primea}
  is a function from atomic propositions to the powerset of \pf{\primea},
  that is, it is
  an element of the type \pftext{\ep{atProp $\Rightarrow$ \primea\  set}},
  for which we
  introduce the abbreviation\footnote{See \cite[p.24]{tutorial:isabellehol} for more
on \texttt{type\_synonym}.} *}

type_synonym 'a model = "(atProp \<Rightarrow>'a set)"

text {* In particular, the notion of model above cannot have empty carrier. Alternatively,
  we could have defined a model over \pf{$'a$} as a pair of a possible
  empty subset of \pf{$'$a} and a function
  \pftext{\ep{atProp $\Rightarrow$ \primea\  set}}
  but then we would need an extra condition to make sure that
  the image of the function lies inside that carrier.
  In other words, we  get the additional
  complication of
  specifying the well formed models among the premodels as in *}

type_synonym 'a pre_model = "'a set \<times> (atProp \<Rightarrow> 'a set)"
definition wf_model :: "'a pre_model \<Rightarrow> bool"
  where "wf_model M \<equiv> let (M,f) = M in (! p. f p \<subseteq> M)"

text {* In the following we will only use the first alternative and
  not make use of pre-model and wf-model. *}

text {* The lecture notes continue with the definition of satisfiability
  \begin{qcolor}
  $$\Model \models  \mbox{\sf All $p$ are $q$} \quadiff
    \semantics{p} \subseteq \semantics{q}
    $$
  \end{qcolor}
  which we formalize as follows.
*}

fun satisfies :: "'a model \<Rightarrow> formula \<Rightarrow> bool" ("_ \<Turnstile> _" )
where
  "satisfies M (All x are y) = (M x \<subseteq> M y)"

(* Do we want a discussion about fun and possible alternatives (see below)? *)

(*
definition satisfies :: "'a model \<Rightarrow> formula \<Rightarrow> bool" where
"satisfies M f \<equiv> case f of All x are y \<Rightarrow> (M x \<subseteq> M y)"
*)

(* definitions cant pattern match, because they are native HOL *)
(*
definition satisfies :: "'a model \<Rightarrow> formula \<Rightarrow> bool" where
"satisfies M (All x are y) \<equiv> (M x \<subseteq> M y)"
*)

text {* The lecture notes continue with the following example. *}

text{*
\begin{qcolor}
\textbf{Example.}
Let $\bP = \{n,p,q\}$. %(Hence $\AA$ has exactly nine sentences.)
Let $M = \{1,2, 3,4, 5\}$.
Let
$\semantics{n} = \emptyset$,
 $\semantics{p} = \{1,3, 4\}$,
 and $\semantics{q} = \{1,3\}$.
This specifies a model $\Model$.
The following sentences are
true in $\Model$:  {\sf All $n$ are $n$},
 {\sf All $n$ are $p$},
 {\sf All $n$ are $q$},    {\sf All $p$ are $p$}, {\sf All $q$ are $p$},
 and {\sf All $q$ are $q$}.
The other three sentences in $\AA$ are false in $\Model$.
\end{qcolor}
*}

text {*
The interesting   question is how to formalise the three ``let" statements above.
In particular, the ``let $M=\dots$'' is formalized differently than the other two.
The reason is that the carrier $M$ of the model is formalized as a
type parameter. Therefore we can instantiate it by defining a datatype: *}

datatype example_2_1 = e1 | e2 | e3 | e4 | e5

text {*The other two ``let" statements are translated as assumptions.
For the first one, note that \pftext{\ep{UNIV :: atProp set}} is the
Isabelle way of naming \pf{UNIV} as the largest set in \pf{atProp set},
that is, \pf{UNIV} is \pf{atProp} seen as a set. For the second note
that Isabelle infers the type of the carrier of $M$ upon reading
\pf{M p = \{e1,e3,e4\}}, the elements of which are elements of the
type \pf{example-2-1}. We can now formalize and prove the claims made
in the exercise.
*}

lemma example_2_1:
assumes "(UNIV :: atProp set) = {n,p,q} \<and> n\<noteq>p \<and> n\<noteq>q \<and> p\<noteq>q"
assumes "M n = {}  \<and>  M p = {e1,e3,e4}  \<and>  M q = {e1,e3}"
shows "M \<Turnstile> All n are n"
   and "M \<Turnstile>All n are p"
   and "M \<Turnstile>All n are q"
   and "M \<Turnstile> All p are p"
   and "M \<Turnstile> All q are p"
   and "M \<Turnstile> All q are q"
   and "\<not> (M \<Turnstile> All p are n)"
   and "\<not> (M \<Turnstile> All p are q)"
   and "\<not> (M \<Turnstile> All q are n)"
proof %invisible -
  show "M \<Turnstile> All n are n" by simp
  show "M \<Turnstile> All n are p" by (metis assms(2) empty_subsetI satisfies.simps)
  show "M \<Turnstile> All n are q" by (metis assms(2) bot.extremum satisfies.simps)
  show "M \<Turnstile> All p are p" by simp
  show "M \<Turnstile> All q are p" by (metis assms(2) insert_mono satisfies.simps subset_insertI)
  show "M \<Turnstile> All q are q" by simp
  show "\<not> (M \<Turnstile> All p are n)" by (metis assms(2) bot.extremum_unique insert_not_empty satisfies.simps)
  show "\<not> (M \<Turnstile> All p are q)" by (metis assms(2) empty_iff example_2_1.distinct(15) example_2_1.distinct(5) insert_iff insert_subset satisfies.simps)
  show "\<not> (M \<Turnstile> All q are n)" by (metis assms(2) insert_not_empty satisfies.simps subset_empty)
qed

text {* The proof of the 9 statements can be done
automatically using sledgehammer \cite{tutorial:sledgehammer}. Sledgehammer is an Isabelle command
that calls automatic
theorem provers, either locally installed or over the internet, in order to prove
the current goal. For us, sledgehammer is a crucial ingredient of Isabelle. It allows us to conduct
proofs close to the level of pen and paper mathematics. Whenever in these notes, or in the theory files,
 you see a \pf{{\bf by}\ep{metis \ldots}} this shows a proof found by sledgehammer.
Actually, for better readability of this document, we made most of these automatically found proofs invisible as can easily
be seen by comparing directly with the theory file.

\medskip We emphasize that the proofs \pf{{\bf by}\ep{metis \ldots}} are not meant to be readable
by humans. In our notes, they are usually proofs that are obvious on the mathematical level of
abstraction. On the other hand, if you know that such a proof depends on a particular fact
it is a good idea to check whether this fact is contained in the list of facts appearing in the
dots of a \pf{{\bf by}\ep{metis \ldots}}.
\marginpar[left text]{video}
*}

text {* The lecture notes continue with extending satisfiability to sets
  of formulas
\begin{qcolor}
\begin{center}
$\Model\models\Gamma$ iff $\Model\models \phi$ for every $\phi\in \Gamma$
\end{center}
\end{qcolor}

and to semantic entailment between sets of formulas and formulas
\begin{qcolor}
\begin{center}
$\Gamma\models \phi$ iff  for all $\Model$: if  $\Model\models \Gamma$,  then
also $\Model\models\phi$.
\end{center}
\end{qcolor}
which we formalize as follows.
\specialbox{Overloading names, although possible to a degree, is not
as easy in Isabelle as it is in pen and paper maths. For example,
comparing the definitions of \pf{satisfies} and \pf{M-satisfies-G}
one would think that, as they have different types, both could well
have the same name, or, at least, use the same notation $\models$.
But one problem here is that the parsing is done before the
type checking and ambiguous parse trees would result
(recommended experiment). So this is a point that requires
some compromise from the mathematician's perspective.}
 *}

definition M_satisfies_G :: "'a model \<Rightarrow> formula set \<Rightarrow> bool" ("_ \<Turnstile>M _")
where
  "M_satisfies_G M G  \<equiv> \<forall>f. f \<in> G \<longrightarrow> (M \<Turnstile> f)"

text {*
If we want to define semantic consequence or entailment, we want to say
that $G\models g$ iff $\forall M :: {'a} \textit{ model}.
M\models G \rightarrow M\models g$. Due to the free type variable
$'a$ we run into a slight technical difficulty. For reasons explained
in some detail in \cite{Arthan14}, every variable on the right of a
definition also needs to appear on the left.
So we could write, using a dummy term \pf{ty}, \ldots
*}

definition entails_b :: "formula set \<Rightarrow> formula \<Rightarrow> 'a \<Rightarrow> bool"
where
  "entails_b G f (ty::'a) \<equiv> \<forall> (M::'a model). (M \<Turnstile>M G) \<longrightarrow> (M \<Turnstile> f)"

text {* \dots but this definition has the disadvantage that it looks
as if the function \pf{entails} depended on values of type $'a$.
One way out is to use the ``type itself'' construction, which
provides a type depending on $'a$ with only element (this element is denoted by
TYPE($'a$) and we will encounter it later). More on the
itself type can be found in \cite{Wenzel97}.*}

definition entails :: "formula set \<Rightarrow> formula \<Rightarrow> 'a itself \<Rightarrow> bool" ("_ \<Turnstile>G _ _")
where
  "entails G f (ty::'a itself) \<equiv> \<forall> (M::'a model). (M \<Turnstile>M G) \<longrightarrow> (M \<Turnstile> f)"

(* can we show in Isabelle that an itself type has only one element? *)

(*
lemma itself_a:
shows "card( UNIV :: 'a itself set)=1"
oops
*)

(*
declare [[show_types]]

lemma itself_b:
fixes x y
assumes "x \<in> (UNIV :: 'a itself set)"
assumes "y \<in> (UNIV :: 'a itself set)"
shows "x=y"
find_theorems name:itself
using HOL.equal_itself_def
sorry

lemma itself_c:
assumes "x :: 'a itself set"
assumes "y :: 'a itself set"
shows "x=y"
*)

text {* \textbf{Further Reading. } For general background on Isabelle see Paulson's
original \cite{Paulson89} (in particular Section 1 and 2). \cite{Paulson89} also
gives a reason why types are assumed to be non-empty. In
 \cite[p.119]{tutorial:isabellehol} one can find a model checker as a worked out
example. *}

subsection {* Proof Theory --- Rules and Natural Deduction in Isabelle *}

text {*

The deductive system $\AA$ is given as

\begin{qcolor}
\begin{framed}
$$ \begin{array}{lcl}
\infer[\mbox{\sc Axiom}]{ \mbox{\sf  All  $p$  are  $p$ }}{}
& \qquad &
\infer[\mbox{\sc Barbara}]{ \mbox{\sf  All  $p$  are  $q$ }}{ \mbox{\sf  All  $p$  are  $n$}
&   \mbox{\sf  All  $n$ are  $q$ }}
\\
\end{array}
$$
\end{framed}
\end{qcolor}

which is formalized as follows. (The 0 in \pf{0\ $\vdash$\ -} is an
annotation to avoid overloading wrt to \pf{-\ $\vdash$\ -} in the
next definition.)
*}

inductive derivable :: "formula \<Rightarrow> bool" ("0\<turnstile> _")
where
  A_axiom: "0\<turnstile> (All X are X)"
| A_barbara: "\<lbrakk>0\<turnstile>(All X are Y); 0\<turnstile>(All Y are Z)\<rbrakk> \<Longrightarrow> 0\<turnstile>(All X are Z)"

text {*
\specialbox{
Isabelle implements natural deduction. The Isabelle notation for a rule of the
shape
$$\infer[\mbox{\it name}]{ \mbox{\sf  C}}{ \mbox{\sf  A}
&   \mbox{\sf  B}}$$
is $$\pftext{ name: $\semantics{A;B} \Longrightarrow$ \sf C}$$
as in the rules \pf{A-axiom} and \pf{A-barbara} above.
}
*}

text {* \specialbox{ Something about "inductive" } *}

text {* Let us look at how to reason in Isabelle using the natural
deduction rules. The following example is again from the lecture notes. *}

text {*
\begin{qcolor}
\textbf{Example. }
Let $\Gamma$ be
$$\set{ \mbox{\sf All $l$ are $m$},  \mbox{\sf All $q$ are $l$},
 \mbox{\sf All $m$ are $p$}, \mbox{\sf All $n$ are $p$},   \mbox{\sf All $l$ are $q$}}$$
Let $\phi$ be    {\sf All $q$ are $p$}.  Here is a proof tree showing that
$\Gamma\proves \phi$:
\begin{framed}
$$
\infer[\mbox{\sc Barbara}]{ \mbox{\sf All $q$ are $p$}}{  \mbox{\sf All $q$ are $l$} &
\infer[\mbox{\sc Barbara}]{ \mbox{\sf All $l$ are $p$}}{
\infer[\mbox{\sc Barbara}]{\mbox {\sf All $l$ are $m$}}{ \mbox{\sf All $l$ are $m$} &
\infer[\mbox{\sc Axiom}]{\mbox{\sf All $m$ are $m$}}{}}
&   \mbox{\sf All $m$ are $p$}}}
$$
\end{framed}
\end{qcolor}
The proof tree
can be implemented in Isabelle as follows.
*}

lemma example_2_5:
assumes "0\<turnstile>All l are m"
and "0\<turnstile>All q are l"
and "0\<turnstile>All m are p"
and "0\<turnstile>All n are p"
and "0\<turnstile>All l are q"
shows "0\<turnstile> All q are p"

apply (rule_tac Y=l in A_barbara)
 apply (rule assms(2))

 apply (rule_tac Y=m in A_barbara)
  apply (rule_tac Y=m in A_barbara)
   apply (rule assms(1))

   apply (rule A_axiom)
  apply (rule assms(3))
done

text {* Comparing the Isabelle proof with the paper proof, we see
that in Isabelle we reasoned backwards from the goal \pf{All q are p}.
The first \pf{{\bf apply} \ep{rule-tac Y=l in A-barbara}}, for example,
corresponds to the bottom application of the {\sc Barbara} rule.
\marginpar[left text]{video}
*}

text {* \specialbox{ here it would be good to have an
exercise for the reader } *}

text {* Later in the lecture notes we want to compare derivability from assumptions with
semantic entailment, so we define $\Gamma\vdash\phi$ as a variation of
the above $\vdash\phi$: *}

inductive derives :: "formula set \<Rightarrow> formula \<Rightarrow> bool" ("_ \<turnstile> _")
where
  A_assumption: "f \<in> hs \<Longrightarrow>  hs \<turnstile> f"
| A_axiom: "hs \<turnstile> (All X are X)"
| A_barbara: "\<lbrakk>hs \<turnstile>(All X are Y); hs \<turnstile>(All Y are Z)\<rbrakk> \<Longrightarrow> hs \<turnstile>(All X are Z)"

text {* Accordingly, we have the following variation of the above
example.
 *}

lemma example_2_5_b:
fixes l m n p q
defines "G_2_5  \<equiv> {All l are m,All q are l,All m are p,All n are p,All l are q}"
shows "G_2_5 \<turnstile> All q are p"
apply (rule_tac Y=l in A_barbara)
 apply (rule A_assumption) apply (simp add: G_2_5_def)
  apply (rule_tac Y=m in A_barbara)
    apply (rule_tac Y=m in A_barbara)
     apply (rule A_assumption) apply (simp add: G_2_5_def)

     apply (rule A_axiom)
    apply (rule A_assumption) apply (simp add: G_2_5_def)
done

text {* The proof is similar to the first one, but instead of referring
to an assumption of the lemma, we use now the rule \pf{A-assumption}.
After applying the rule \pf{A-assumption}, Isabelle leaves us with a
subgoal, namely
\pftext{ All q are l
    $\in$ G-2-5 }
which is obviously true and easy to discharge by
\pf{{\bf apply} \ep{simp add: G-2-5-def}}.
\footnote{A summary of rules is given in \cite[Section 5.7]{tutorial:isabellehol}.
Chapter 5 also contains a general introduction to the logic of Isabelle.}

\specialbox{ maybe a bit more about auto, simp, etc ... \cite[Section 3.1]{tutorial:isabellehol}}
*}

text {*
Next we come to our first mathematical result on the calculus, namely
that it is sound. Recall that \pf{TYPE\ep{atProp}} is the unique element
of the type \pf{atProp itself}, which appears in the definition of $\models{}G$.
*}

lemma prop_2_2_1:
  fixes G g
  assumes "G \<turnstile> g"
  shows  "G \<Turnstile>G g (TYPE(atProp))"
using assms
proof (induct rule: derives.induct)
  case (A_assumption)
  show ?case
by (metis A_assumption.hyps M_satisfies_G_def entails_def)
next
  case (A_axiom)
  show ?case by (metis entails_def order_refl satisfies.simps)
next
  case (A_barbara)
  show ?case by (metis A_barbara.hyps(2) A_barbara.hyps(4) entails_def satisfies.simps subset_trans)
qed

text {* To quote from the book:
\begin{qcolor}The soundness proofs of all the logical systems in this book are all pretty much the same.
They are always inductions, and the crux of the matter is usually a simple fact about sets.
(Above, the crux of the matter is that the inclusion relation $\subseteq$ on
 subsets of a given set is always a transitive relation.)
We almost never present the soundness proof in any detail.\end{qcolor}
The Isabelle proof gives another justification for skipping the details of the
mathematical soundness proof:
After telling Isabelle that we want to use induction and after
listing the cases, the details of the
proof are done automatically using sledgehammer, that is, the three lines above
\pf{{\bf by} \ep{metis \dots}} are provided
by an automatic theorem prover. For us, this essentially means that no
mathematical ideas are needed.
%
\footnote{Although it is clear that with automatic theorem proving
becoming more and more powerful it will happen more  and more often that automatic provers will find
proofs that would require ideas from a human point of view. On the other hand, for the proofs of
this section, there is an astonishingly good match between the details one would hide in a
pen and paper proof and the details that can be discharged by an automatic theorem prover.}
%

\medskip It may also be worth noting that the Isabelle proof is quite a bit shorter than the proof
in the book. Usually, such easy
proofs do not make it into the literature. Nowadays that can be done without sacrificing rigor by delegating
these proofs to a theorem prover.
Moreover, checking all the cases using the tool may well be faster then
checking the cases (carefully) by hand.
 *}

text {* \textbf{Further Reading. } Section 3 and 4 of \cite{Paulson89} contain
an exposition of Isabelle's meta-logic and an example of an object logic.
*}

subsection {* Completeness --- Proofs in Isabelle/Isar *}

text {* Isabelle supports two styles of proof, apply-style and Isar-style.
We have seen an example of both. The proof for Example 2.5 was given
apply-style. This is very convenient for that type of problem, which
consists in finding a derivation in a calculus, the rules of which
have been directly encoded using Isabelle rules.

\medskip But the proof of the soundness result in Proposition 2.2.1 was written
in a very different style. As an exercise you might want to
try and do the soundness proof apply-style, starting with
\begin{verbatim}
  apply (rule derives.induct)
  apply (rule assms)
\end{verbatim}
You will notice that you will need to know quite a bit about
how Isabelle proofs are implemented internally. Instead, the Isar proof language
\cite{isar} allows proofs to be written in a style much closer to informal proofs
and is much quicker to learn.
This section will present more examples and some exercises, for background and details
see the introduction \cite{tutorial:isar}. A useful resource is also the
Isabelle/Isar reference manual \cite{isar}, in particular Appendix A.
*}

text {* Coming back to the development of the syntax and semantics of our logic,
it is the next
definition which is the crucial one as it links up both syntax and semantics:
Given a theory $G$,
  derivability induces a preorder on atomic propositions, which is then
used to define the notion of canonical model below.  *}

definition less_equal_atprop :: "atProp \<Rightarrow> formula set \<Rightarrow> atProp \<Rightarrow> bool" ("_ \<lesssim>_ _")
where
  "less_equal_atprop u G v \<equiv> G \<turnstile> All u are v"

text {* We show that \isasymlesssim\ is a preorder. We would
hope that there is a theory about orders and preorders ready for us
to use and to find
it we write: *}

find_theorems name:preorder

text {* After which, in the output window, we find
\begin{verbatim}
  Order_Relation.preorder_on_empty: preorder_on {} {}
\end{verbatim}
Pressing the command key, hovering over the line above and clicking without delay
brings up the theory \verb+Order_Relation+
and the definition of \verb+preorder_on+, which takes two arguments,
a set $A$ and a relation, ie, a subset of $A\times A$. The relation
in question is $\{(x,y) \mid x\; {\lesssim}G\; y\}$. The set on which this
relation lives can be given by using \pf{UNIV}.
\marginpar[left text]{video}
*}

lemma prop_2_4_1:
  fixes G
  shows "preorder_on UNIV { (x,y). x \<lesssim>G y }"
proof (auto simp add: preorder_on_def)
   show "refl { (x,y). x \<lesssim>G y }"
    unfolding refl_on_def
    using A_axiom by (metis UNIV_Times_UNIV case_prodI iso_tuple_UNIV_I less_equal_atprop_def mem_Collect_eq subset_iff)
  show "trans { (x,y). x \<lesssim>G y }"
    unfolding trans_def
    using A_barbara by %invisible (metis (full_types) less_equal_atprop_def mem_Collect_eq split_conv)
qed

text {* As a side remark, the latex code of Proposition 2.4.1 and
its proof in the
book is only 10\% shorter, measured in number of characters, than the
Isabelle code (only part of which is shown above).
*}

text {* Next we give the definition of the canonical model of a theory $G$.
In words it says that in the canonical model
the interpretation of the atomic proposition $u$
is the set of all atomic propositions smaller or equal to $u$. *}

definition "canonical_model G u \<equiv> { v. v \<lesssim>G u }"

text {* The next lemma confirms that the canonical model of $G$
satisfies $G$: *}

lemma lemma_2_4_2:
  fixes G assumes "M = canonical_model G"
  shows "M \<Turnstile>M G"
proof (auto simp add: M_satisfies_G_def)
  fix g  assume "g \<in> G"
  then obtain p q where "(All p are q) = g" by %invisible (metis formula.exhaust)

  then have "p \<lesssim>G q" using A_assumption by %invisible (metis (full_types) `g \<in> G` less_equal_atprop_def)

  then have "M p \<subseteq> M q" using A_barbara by %invisible (metis assms canonical_model_def less_equal_atprop_def mem_Collect_eq subsetI)

  thus "M \<Turnstile> g" by %invisible (metis `(All p are q) = g` satisfies.simps)

qed

text{* Next comes the completeness theorem. *}

lemma thm_2_4_3:
  assumes "G \<Turnstile>G (All p are q) (TYPE(atProp))"
  shows "G \<turnstile> All p are q"
proof -
  define M where "M = canonical_model G"
  have "M \<Turnstile> All p are q" using lemma_2_4_2 by %invisible (metis (full_types) M_def assms entails_def)

  then have "M p \<subseteq> M q" by %invisible auto

  have "p \<lesssim>G p" using A_axiom by %invisible (metis less_equal_atprop_def)

  then have "p \<in> M p" using canonical_model_def by %invisible (metis M_def mem_Collect_eq)

  have "p \<in> M q" using `M p \<subseteq> M q` by %invisible (metis `p \<in> M p`  set_rev_mp)

  then have "p \<lesssim>G q" using canonical_model_def by %invisible (metis M_def  mem_Collect_eq)

  thus ?thesis by %invisible (metis less_equal_atprop_def)

qed

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Closure Operators\<close>
theory Closure_Operators
  imports
    Order_Functions_Base
begin

definition "idempotent_on P R f \<equiv> rel_equivalence_on P (rel_map f R) f"

lemma idempotent_onI [intro]:
  assumes "\<And>x. P x \<Longrightarrow> f x \<equiv>\<^bsub>R\<^esub> f (f x)"
  shows "idempotent_on P R f"
  unfolding idempotent_on_def using assms by fastforce

lemma idempotent_onE [elim]:
  assumes "idempotent_on P R f"
  and "P x"
  obtains "R (f (f x)) (f x)" "R (f x) (f (f x))"
  using assms unfolding idempotent_on_def by fastforce

lemma rel_equivalence_on_rel_map_iff_idempotent_on [iff]:
  "rel_equivalence_on P (rel_map f R) f \<longleftrightarrow> idempotent_on P R f"
  unfolding idempotent_on_def by simp

lemma bi_related_if_idempotent_onD:
  assumes "idempotent_on P R f"
  and "P x"
  shows "f x \<equiv>\<^bsub>R\<^esub> f (f x)"
  using assms by blast

definition "idempotent (R :: 'a \<Rightarrow> _) f \<equiv> idempotent_on (\<top> :: 'a \<Rightarrow> bool) R f"

lemma idempotent_eq_idempotent_on:
  "idempotent (R :: 'a \<Rightarrow> _) f = idempotent_on (\<top> :: 'a \<Rightarrow> bool) R f"
  unfolding idempotent_def ..

lemma idempotentI [intro]:
  assumes "\<And>x. R (f (f x)) (f x)"
  and "\<And>x. R (f x) (f (f x))"
  shows "idempotent R f"
  unfolding idempotent_eq_idempotent_on using assms by blast

lemma idempotentE [elim]:
  assumes "idempotent R f"
  obtains "R (f (f x)) (f x)" "R (f x) (f (f x))"
  using assms unfolding idempotent_eq_idempotent_on by (blast intro: top1I)

lemma idempotent_on_if_idempotent:
  fixes P :: "'a \<Rightarrow> bool" and R :: "'a \<Rightarrow> _"
  assumes "idempotent R f"
  shows "idempotent_on P R f"
  using assms by (intro idempotent_onI) auto

definition "closure_operator R f \<equiv>
  (R \<Rrightarrow>\<^sub>m R) f \<and> inflationary_on (in_field R) R f \<and> idempotent_on (in_field R) R f"

lemma closure_operatorI [intro]:
  assumes "(R \<Rrightarrow>\<^sub>m R) f"
  and "inflationary_on (in_field R) R f"
  and "idempotent_on (in_field R) R f"
  shows "closure_operator R f"
  unfolding closure_operator_def using assms by blast

lemma closure_operatorE [elim]:
  assumes "closure_operator R f"
  obtains "(R \<Rrightarrow>\<^sub>m R) f" "inflationary_on (in_field R) R f"
    "idempotent_on (in_field R) R f"
  using assms unfolding closure_operator_def by blast

lemma mono_wrt_rel_if_closure_operator:
  assumes "closure_operator R f"
  shows "(R \<Rrightarrow>\<^sub>m R) f"
  using assms by (elim closure_operatorE)

lemma inflationary_on_in_field_if_closure_operator:
  assumes "closure_operator R f"
  shows "inflationary_on (in_field R) R f"
  using assms by (elim closure_operatorE)

lemma idempotent_on_in_field_if_closure_operator:
  assumes "closure_operator R f"
  shows "idempotent_on (in_field R) R f"
  using assms by (elim closure_operatorE)

end