theory STLLoss_max_min

imports Complex_Main
  "HOL-Analysis.Analysis"
  "HOL-Library.Lub_Glb"

begin

(* definition of the max and min gamma functions *)
(* expanded definition to match original paper where \<gamma> can equal 0 *)

fun logsumexp :: "real \<Rightarrow> real \<Rightarrow> real" where
  "logsumexp a b = (if a < b then a + ln ((1::real) + exp (b - a)) else
  (if b < a then b + ln ((1::real) + exp (a - b)) else
  a + ln (2::real)))"

function Max_gamma_comp :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "Max_gamma_comp \<gamma> a b = (if \<gamma> \<le> (0::real) then max a b
  else \<gamma> * (if (a/\<gamma>) < (b/\<gamma>) then (a/\<gamma>) + ln ((1::real) + exp ((b/\<gamma>) - (a/\<gamma>))) else
  (if (b/\<gamma>) < (a/\<gamma>) then (b/\<gamma>) + ln ((1::real) + exp ((a/\<gamma>) - (b/\<gamma>))) else
  (a/\<gamma>) + ln ((1::real)+(1::real)))))"
  by pat_completeness auto
termination by size_change

lemma Max_gamma_comp_equiv:"Max_gamma_comp \<gamma> a b = (if \<gamma> \<le> (0::real) then max a b
  else \<gamma> * (if (a/\<gamma>) < (b/\<gamma>) then (a/\<gamma>) + ln (1 + exp ((b/\<gamma>) - (a/\<gamma>))) else
  (if (b/\<gamma>) < (a/\<gamma>) then (b/\<gamma>) + ln (1 + exp ((a/\<gamma>) - (b/\<gamma>))) else
  (a/\<gamma>) + ln (2))))"
  by auto

function Min_gamma_comp :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "Min_gamma_comp \<gamma> a b = (if \<gamma> \<le> (0::real) then min a b
  else -\<gamma> * (if (-a/\<gamma>) < (-b/\<gamma>) then (-a/\<gamma>) + ln ((1::real) + exp ((-b/\<gamma>) - (-a/\<gamma>))) else
  (if (-b/\<gamma>) < (-a/\<gamma>) then (-b/\<gamma>) + ln ((1::real) + exp ((-a/\<gamma>) - (-b/\<gamma>))) else
  (-a/\<gamma>) + ln ((1::real)+(1::real)))))"
  by pat_completeness auto
termination by size_change

lemma Min_gamma_comp_equiv:  "Min_gamma_comp \<gamma> a b = (if \<gamma> \<le> (0::real) then min a b
  else -\<gamma> * (if (-a/\<gamma>) < (-b/\<gamma>) then (-a/\<gamma>) + ln (1 + exp ((-b/\<gamma>) - (-a/\<gamma>))) else
  (if (-b/\<gamma>) < (-a/\<gamma>) then (-b/\<gamma>) + ln (1 + exp ((-a/\<gamma>) - (-b/\<gamma>))) else
  (-a/\<gamma>) + ln (2))))"
  by auto

fun Max_gamma :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "Max_gamma \<gamma> a b = (if \<gamma> \<le> 0 then max a b
    else \<gamma> * ln (exp (a/\<gamma>) + exp (b/\<gamma>)))"

fun Min_gamma :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "Min_gamma \<gamma> a b = (if \<gamma> \<le> 0 then min a b
    else -\<gamma> * ln (exp (-a/\<gamma>) + exp (-b/\<gamma>)))"

lemma Max_gamma_comp_eq:"Max_gamma_comp \<gamma> a b = Max_gamma \<gamma> a b"
proof (cases "\<gamma>\<le>0")
  case True
  then show ?thesis
  by simp
next
  case False
  then have 1:"Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (b/\<gamma>))"
    by simp
  have 2:"exp (a/\<gamma>) > 0 \<and> (1 + exp ((b-a)/\<gamma>)) > 0 \<and>  (1 + exp ((a-b)/\<gamma>)) > 0 \<and> exp (b/\<gamma>) > 0"
    by (simp add: add_pos_nonneg)
  have 3:"Max_gamma_comp \<gamma> a b = \<gamma> * (if (a/\<gamma>) < (b/\<gamma>) then (a/\<gamma>) + ln (1 + exp ((b/\<gamma>) - (a/\<gamma>))) else
    (if (b/\<gamma>) < (a/\<gamma>) then (b/\<gamma>) + ln (1 + exp ((a/\<gamma>) - (b/\<gamma>))) else
    (a/\<gamma>) + ln 2))"
    using False by simp
  then show ?thesis
  proof (cases "(a/\<gamma>)<(b/\<gamma>)")
    case True
    then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (((b-a)+a)/\<gamma>))"
      using 1 by simp
    then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (a/\<gamma>) * exp ((b-a)/\<gamma>))"
      using add.commute add_divide_distrib mult_exp_exp by metis
    then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) * (1 + exp ((b-a)/\<gamma>)))"
      by (simp add: distrib_left)
    then have "Max_gamma \<gamma> a b = \<gamma> * ((a/\<gamma>) + ln (1 + exp ((b-a)/\<gamma>)))"
      using ln_mult 2 ln_exp by presburger
    then have 4:"Max_gamma \<gamma> a b = \<gamma> * ((a/\<gamma>) + ln (1 + exp ((b/\<gamma>)-(a/\<gamma>))))"
      by argo
    then have "Max_gamma_comp \<gamma> a b = \<gamma> * ((a/\<gamma>) + ln (1 + exp ((b/\<gamma>)-(a/\<gamma>))))"
      using True 3 by simp
    then show ?thesis
      using 4 by simp
  next
    case False
      then show ?thesis
      proof (cases "(b/\<gamma>)<(a/\<gamma>)")
        case True
      then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (((a-b)+b)/\<gamma>) + exp (b/\<gamma>))"
        using 1 by simp
      then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (b/\<gamma>) + exp (b/\<gamma>) * exp ((a-b)/\<gamma>))"
        using add.commute add_divide_distrib mult_exp_exp by metis
      then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (b/\<gamma>) * (1 + exp ((a-b)/\<gamma>)))"
        by (simp add: distrib_left)
      then have "Max_gamma \<gamma> a b = \<gamma> * ((b/\<gamma>) + ln (1 + exp ((a-b)/\<gamma>)))"
        using ln_mult 2 ln_exp by presburger
      then have 4:"Max_gamma \<gamma> a b = \<gamma> * ((b/\<gamma>) + ln (1 + exp ((a/\<gamma>)-(b/\<gamma>))))"
        by argo
      then have "Max_gamma_comp \<gamma> a b = \<gamma> * ((b/\<gamma>) + ln (1 + exp ((a/\<gamma>)-(b/\<gamma>))))"
        using True 3 by simp
      then show ?thesis
        using 4 by simp
    next
      case False
      then have 4:"(a/\<gamma>) = (b/\<gamma>)"
        using \<open>\<not>(a/\<gamma>)<(b/\<gamma>)\<close> by auto
      then have "Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (a/\<gamma>))"
        using 1 by presburger
      then have "Max_gamma \<gamma> a b = \<gamma> * ln (2 * exp (a/\<gamma>))"
        by simp
      then have 5:"Max_gamma \<gamma> a b = \<gamma> * (ln 2 + (a/\<gamma>))"
        using ln_mult 2 ln_exp by simp
      then have "Max_gamma_comp \<gamma> a b = \<gamma> * (ln 2 + (a/\<gamma>))"
        using 3 4 by auto
      then show ?thesis
        using 5 by simp
    qed
  qed
qed

lemma Min_gamma_comp_eq:"Min_gamma_comp \<gamma> a b = Min_gamma \<gamma> a b"
proof (cases "\<gamma>\<le>0")
  case True
  then show ?thesis
    by simp
next
  case False
  then have 1:"Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) + exp (-b/\<gamma>))"
    by simp
  have 2:"exp (-a/\<gamma>) > 0 \<and> (1 + exp (-(b-a)/\<gamma>)) > 0 \<and>  (1 + exp (-(a-b)/\<gamma>)) > 0 \<and> exp (-b/\<gamma>) > 0"
    by (simp add: add_pos_nonneg)
  have 3:"Min_gamma_comp \<gamma> a b = -\<gamma> * (if (-a/\<gamma>) < (-b/\<gamma>) then
    (-a/\<gamma>) + ln (1 + exp ((-b/\<gamma>) - (-a/\<gamma>))) else
    (if (-b/\<gamma>) < (-a/\<gamma>) then (-b/\<gamma>) + ln (1 + exp ((-a/\<gamma>) - (-b/\<gamma>))) else
    (-a/\<gamma>) + ln 2))"
    using False by simp
  then show ?thesis
  proof (cases "(-a/\<gamma>)<(-b/\<gamma>)")
    case True
    then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) + exp (((-b+a)-a)/\<gamma>))"
      using 1 by simp
    then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) + exp (-a/\<gamma>) * exp ((-b+a)/\<gamma>))"
      using add.commute add_divide_distrib mult_exp_exp uminus_add_conv_diff by metis
    then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) * (1 + exp ((-b+a)/\<gamma>)))"
      by (simp add: distrib_left)
    then have "Min_gamma \<gamma> a b = -\<gamma> * ((-a/\<gamma>) + ln (1 + exp ((-b+a)/\<gamma>)))"
      using ln_mult 2 ln_exp by simp
    then have 4:"Min_gamma \<gamma> a b = -\<gamma> * ((-a/\<gamma>) + ln (1 + exp ((-b/\<gamma>)-(-a/\<gamma>))))"
      by argo
    then have "Min_gamma_comp \<gamma> a b = -\<gamma> * ((-a/\<gamma>) + ln (1 + exp ((-b/\<gamma>)-(-a/\<gamma>))))"
      using True 3 by simp
    then show ?thesis
      using 4 by simp
  next
    case False
      then show ?thesis
      proof (cases "(-b/\<gamma>)<(-a/\<gamma>)")
        case True
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (((-a+b)-b)/\<gamma>) + exp (-b/\<gamma>))"
        using 1 by simp
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (((-a+b)+(-b))/\<gamma>) + exp (-b/\<gamma>))"
        using 1 by simp
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-b/\<gamma>) + exp (-b/\<gamma>) * exp ((-a+b)/\<gamma>))"
        using add.commute add_divide_distrib mult_exp_exp by metis
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-b/\<gamma>) * (1 + exp ((-a+b)/\<gamma>)))"
        by (simp add: distrib_left)
      then have "Min_gamma \<gamma> a b = -\<gamma> * ((-b/\<gamma>) + ln (1 + exp ((-a+b)/\<gamma>)))"
        using ln_mult 2 ln_exp by simp
      then have 4:"Min_gamma \<gamma> a b = -\<gamma> * ((-b/\<gamma>) + ln (1 + exp ((-a/\<gamma>)-(-b/\<gamma>))))"
        by argo
      then have "Min_gamma_comp \<gamma> a b = -\<gamma> * ((-b/\<gamma>) + ln (1 + exp ((-a/\<gamma>)-(-b/\<gamma>))))"
        using True 3 by simp
      then show ?thesis
        using 4 by simp
    next
      case False
      then have 4:"(-a/\<gamma>) = (-b/\<gamma>)"
        using \<open>\<not>(-a/\<gamma>)<(-b/\<gamma>)\<close> by auto
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) + exp (-a/\<gamma>))"
        using 1 by presburger
      then have "Min_gamma \<gamma> a b = -\<gamma> * ln (2 * exp (-a/\<gamma>))"
        by simp
      then have 5:"Min_gamma \<gamma> a b = -\<gamma> * (ln 2 + (-a/\<gamma>))"
        using ln_mult 2 ln_exp by simp
      then have "Min_gamma_comp \<gamma> a b = -\<gamma> * (ln 2 + (-a/\<gamma>))"
        using 3 4 by auto
      then show ?thesis
        using 5 by simp
    qed
  qed
qed

lemma Max_gamma_comm:
  fixes a::real and b::real
  shows "Max_gamma \<gamma> a b = Max_gamma \<gamma> b a"
proof (cases "\<gamma> \<le> 0")
  case True
  then show ?thesis by simp
next
  case False
  then have 1:"\<And>a b. Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (b/\<gamma>))" by simp
  then have "Max_gamma \<gamma> b a = \<gamma> * ln (exp (b/\<gamma>) + exp (a/\<gamma>))" by auto
  then show ?thesis using 1 add.commute by metis
qed

lemma Max_gamma_nn:
  fixes a b \<gamma> :: real
  assumes "a\<ge>0" "b\<ge>0" "\<gamma>>0"
  shows "Max_gamma (abs \<gamma>) a b \<ge> 0"
proof -
  have "\<not>\<gamma>\<le>0" using assms less_le_not_le by metis
  then have "\<And>a b. Max_gamma \<gamma> a b = \<gamma> * ln (exp (a/\<gamma>) + exp (b/\<gamma>))" by simp
  then show ?thesis using assms Max_gamma_comm divide_nonneg_pos exp_gt_zero ln_ge_iff
      mult_nonneg_nonneg
    by (smt (verit, ccfv_threshold) )
qed

lemma Min_gamma_comm:
  fixes a::real and b::real
  shows "Min_gamma \<gamma> a b = Min_gamma \<gamma> b a"
proof (cases "\<gamma> \<le> 0")
  case True
  then show ?thesis by simp
next
  case False
  then have 1:"\<And>a b. Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a/\<gamma>) + exp (-b/\<gamma>))" by simp
  then have "Min_gamma \<gamma> b a = -\<gamma> * ln (exp (-b/\<gamma>) + exp (-a/\<gamma>))" by auto
  then show ?thesis using 1 add.commute by metis
qed

lemma Max_gamma_works:
  fixes \<epsilon> :: real and a :: real and b :: real and \<gamma> :: real
  assumes eps_pos:"\<epsilon>>0"
      and gamma_pos:"\<gamma>>0"
      and gamma_less:"\<gamma><(\<epsilon>/ln 2)"
    shows "\<bar>Max_gamma \<gamma> a b - max a b\<bar> < \<epsilon>"
proof -
  obtain c::real and d::real where cd_defn:"c = max a b \<and> d = min a b" by simp
  have "(c = a \<and> d = b) \<or> (c = b \<and> d = a)" using cd_defn by auto
  then have 1:"Max_gamma \<gamma> a b = Max_gamma \<gamma> d c" using Max_gamma_comm by blast
  have 2:"\<And>x::real. exp x > 0" by simp
  have "d\<le>c" using cd_defn by simp
  then have 21:"exp (d/\<gamma>) \<le> exp (c/\<gamma>)" using gamma_pos divide_right_mono by fastforce
  then have 3:"exp (d/\<gamma>)/exp (c/\<gamma>) \<le> 1" by simp
  then have 31:"exp (d/\<gamma>)/exp (c/\<gamma>) > 0" by simp
  have "Max_gamma \<gamma> a b - c = \<gamma> * (ln (exp (d/\<gamma>) + exp (c/\<gamma>))) - c" using 1 gamma_pos by simp
  also have 4:"Max_gamma \<gamma> a b - c = \<gamma> * (ln ((exp (d/\<gamma>)/exp(c/\<gamma>))*exp(c/\<gamma>) + exp (c/\<gamma>))) - c"
    using calculation by auto
  moreover have "Max_gamma \<gamma> a b - c \<le> \<gamma> * (ln (exp(c/\<gamma>) + exp (c/\<gamma>))) - c" using 3
    by (smt calculation(2) divide_nonneg_nonneg gamma_pos ln_less_cancel_iff mult_left_le_one_le
        nonzero_eq_divide_eq not_exp_le_zero ordered_comm_semiring_class.comm_mult_left_mono)
  moreover have "Max_gamma \<gamma> a b - c \<le> \<gamma> * (ln (2 * exp (c/\<gamma>))) - c" using calculation(3) by auto
  moreover have "Max_gamma \<gamma> a b - c \<le> \<gamma> * (ln 2 + ln (exp (c/\<gamma>))) - c"
    using ln_mult 2 calculation(3) by auto
  moreover have "Max_gamma \<gamma> a b - c \<le> \<gamma> * ln 2 + \<gamma> * c/\<gamma> - c"
    by (metis (no_types, opaque_lifting) calculation(5) div_by_1 divide_divide_eq_right ln_exp
        mult.left_neutral ring_class.ring_distribs(1))
  ultimately have 5:"Max_gamma \<gamma> a b - c \<le> \<gamma> * ln 2"
    using gamma_pos by auto
  have "Max_gamma \<gamma> a b - c > \<gamma> * (ln (exp (c/\<gamma>))) - c" using 31 4
    by (smt (verit, best) gamma_pos ln_less_cancel_iff mult_le_cancel_left_pos mult_pos_pos not_exp_le_zero)
  moreover have "Max_gamma \<gamma> a b - c > \<gamma> * c/\<gamma> - c" using calculation by auto
  ultimately have 6:"Max_gamma \<gamma> a b - c > 0" using gamma_pos by auto
  have "Max_gamma \<gamma> a b - max a b \<le> \<gamma> * ln 2 \<and> Max_gamma \<gamma> a b - max a b > 0"
    using cd_defn 5 6 by simp
  then show ?thesis using gamma_less
    by (simp add: less_divide_eq)
qed

lemma Min_gamma_works:
  fixes \<epsilon> :: real and a :: real and b :: real and \<gamma> :: real
  assumes eps_pos:"\<epsilon>>0"
      and gamma_pos:"\<gamma>>0"
      and gamma_less:"\<gamma><(\<epsilon>/ln 2)"
    shows "\<bar>min a b - Min_gamma \<gamma> a b\<bar> < \<epsilon>"
proof -
  obtain c::real and d::real where cd_defn:"c = -max a b \<and> d = -min a b" by simp
  have "(c = -a \<and> d = -b) \<or> (c = -b \<and> d = -a)" using cd_defn by auto
  then have 1:"Min_gamma \<gamma> a b = Min_gamma \<gamma> (-d) (-c)" using Min_gamma_comm by fastforce
  have 2:"\<And>x::real. exp x > 0" by simp
  have "d\<ge>c" using cd_defn by simp
  then have 21:"exp (d/\<gamma>) \<ge> exp (c/\<gamma>)" using gamma_pos divide_right_mono
    by fastforce
  then have 3:"exp (c/\<gamma>)/exp (d/\<gamma>) \<le> 1" by simp
  then have 31:"exp (c/\<gamma>)/exp (d/\<gamma>) > 0" by simp
  have "-Min_gamma \<gamma> a b - d = \<gamma> * (ln (exp (d/\<gamma>) + exp (c/\<gamma>))) - d" using 1 gamma_pos by simp
  also have 4:"-Min_gamma \<gamma> a b - d = \<gamma> * (ln (exp (d/\<gamma>) + exp(d/\<gamma>) * exp (c/\<gamma>)/exp (d/\<gamma>))) - d"
    using calculation by auto
  moreover have "-Min_gamma \<gamma> a b - d \<le> \<gamma> * (ln (exp(d/\<gamma>) + exp (d/\<gamma>))) - d" using 3
    by (smt 21 calculation(1) gamma_pos ln_less_cancel_iff not_exp_le_zero
        ordered_comm_semiring_class.comm_mult_left_mono)
  moreover have "-Min_gamma \<gamma> a b - d \<le> \<gamma> * (ln (2 * exp (d/\<gamma>))) - d" using calculation(3) by auto
  moreover have "-Min_gamma \<gamma> a b - d \<le> \<gamma> * (ln 2 + ln (exp (d/\<gamma>))) - d"
    using ln_mult 2 calculation(3) by auto
  moreover have "-Min_gamma \<gamma> a b - d \<le> \<gamma> * ln 2 + \<gamma> * d/\<gamma> - d"
    by (metis (no_types, opaque_lifting) calculation(5) div_by_1 divide_divide_eq_right ln_exp
        mult.left_neutral ring_class.ring_distribs(1))
  ultimately have 5:"-Min_gamma \<gamma> a b - d \<le> \<gamma> * ln 2"
    using gamma_pos by auto
  have "-Min_gamma \<gamma> a b - d > \<gamma> * (ln (exp (d/\<gamma>))) - d" using 31 4
    by (smt (verit, best) gamma_pos ln_less_cancel_iff mult_le_cancel_left_pos nonzero_mult_div_cancel_left not_exp_le_zero)
  moreover have "-Min_gamma \<gamma> a b - d > \<gamma> * d/\<gamma> - d" using calculation by auto
  ultimately have 6:"-Min_gamma \<gamma> a b - d > 0" using gamma_pos by auto
  have "min a b - Min_gamma \<gamma> a b \<le> \<gamma> * ln 2 \<and> min a b - Min_gamma \<gamma> a b > 0"
    using cd_defn 5 6 by simp
  then show ?thesis using gamma_less
    by (smt gamma_pos less_divide_eq zero_less_mult_pos)
qed

lemma Max_gamma_lim:
  fixes a b :: real
  shows "(\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0\<rightarrow> max a b"
proof -
  have "(\<forall>r>0. \<forall>x. x > 0 \<and> x < (r/ln 2) \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> a b) x - max a b\<bar> < r)"
    using Max_gamma_works by auto
  then have "(\<forall>r>0. \<exists>s>0. \<forall>x. x > 0 \<and> x < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> a b) x - max a b\<bar> < r)"
    by (metis (full_types) ln_gt_zero one_less_numeral_iff semiring_norm(76) zero_less_divide_iff)
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> a b) x - max a b\<bar> < r"
    by force
  then have 1:"\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm ((\<lambda>\<gamma>. Max_gamma \<gamma> a b) x - (max a b)) < r"
    by simp
  {fix L :: real
    assume "max a b = L"
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm ((\<lambda>\<gamma>. Max_gamma \<gamma> a b) x - L) < r"
    using 1 by simp
  then have "((\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L)"
    using LIM_eq by blast}
  {fix L :: real
    assume 2:"((\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L)"
    then have "((\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0\<rightarrow> max a b)"
      using 1 LIM_eq by blast
    then have "max a b = L"
      using LIM_unique [where ?f="(\<lambda>\<gamma>. Max_gamma \<gamma> a b)"]  2
      by blast}
  then have "\<And>L. (max a b = L) = ((\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L)"
    using \<open>\<And>L. max a b = L \<Longrightarrow> (\<lambda>\<gamma>. Max_gamma \<gamma> a b) \<midarrow>0 \<rightarrow> L\<close>
    by blast
  then show ?thesis
    by blast
qed

lemma Min_gamma_lim:
  fixes a b :: real
  shows "(\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0\<rightarrow> min a b"
proof -
  have "(\<forall>r>0. \<forall>x. x > 0 \<and> x < (r/ln 2) \<longrightarrow> \<bar>(\<lambda>\<gamma>. Min_gamma \<gamma> a b) x - min a b\<bar> < r)"
    using Min_gamma_works by (simp add: abs_minus_commute)
  then have "(\<forall>r>0. \<exists>s>0. \<forall>x. x > 0 \<and> x < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Min_gamma \<gamma> a b) x - min a b\<bar> < r)"
    by (metis (full_types) ln_gt_zero one_less_numeral_iff semiring_norm(76) zero_less_divide_iff)
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Min_gamma \<gamma> a b) x - min a b\<bar> < r"
    by force
  then have 1:"\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm ((\<lambda>\<gamma>. Min_gamma \<gamma> a b) x - (min a b)) < r"
    by simp
  {fix L :: real
    assume "min a b = L"
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm ((\<lambda>\<gamma>. Min_gamma \<gamma> a b) x - L) < r"
    using 1 by simp
  then have "((\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L)"
    using LIM_eq by blast}
  {fix L :: real
    assume 2:"((\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L)"
    then have "((\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0\<rightarrow> min a b)"
      using 1 LIM_eq by blast
    then have "min a b = L"
      using LIM_unique [where ?f="(\<lambda>\<gamma>. Min_gamma \<gamma> a b)"]  2
      by blast}
  then have "\<And>L. ((\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0\<rightarrow> L) = (min a b = L)"
    using \<open>\<And>L. min a b = L \<Longrightarrow> (\<lambda>\<gamma>. Min_gamma \<gamma> a b) \<midarrow>0 \<rightarrow> L\<close>
    by blast
  then show ?thesis
    by blast
qed

lemma lim_chain:
  fixes f g :: "real\<Rightarrow>real" and a b :: real
  assumes "f \<midarrow>b\<rightarrow> L" "g \<midarrow>a\<rightarrow> b" "continuous_on UNIV f"
  shows "(f \<circ> g) \<midarrow>a\<rightarrow> L"
  using LIM_unique UNIV_I assms(1) assms(2) assms(3)
    continuous_on_def filterlim_def tendsto_at_iff_tendsto_nhds tendsto_compose_filtermap
    tendsto_mono
  by metis

lemma real_abs_div_continuous:
  fixes y :: real
  shows "continuous_on ((UNIV::real set)-{0}) (\<lambda>x. y/(abs x))"
proof -
  {fix x1 :: real
    assume "x1\<noteq>0"
    then have "isCont (\<lambda>x. y/(abs x)) x1" by auto}
  then have "\<forall>x1. x1\<notin>{0} \<longrightarrow> isCont (\<lambda>x. y/(abs x)) x1"
    by blast
  then show ?thesis
    using continuous_at_imp_continuous_on
    by blast
qed

lemma real_div_continuous:
  fixes y :: real
  shows "continuous_on ((UNIV::real set)-{0}) (\<lambda>x. y/x)"
proof -
  {fix x1 :: real
    assume "x1\<noteq>0"
    then have "isCont (\<lambda>x. y/x) x1" by auto}
  then have "\<forall>x1\<in>((UNIV::real set)-{0}). isCont (\<lambda>x. y/x) x1"
    by blast
  then show ?thesis
    using continuous_at_imp_continuous_on
    by blast
qed

lemma real_mult_continuous:
  fixes y :: real
  shows "continuous_on (UNIV::real set) (\<lambda>x. (abs x)*y)"
proof -
  {fix x1 :: real
    have "isCont (\<lambda>x. (abs x)*y) x1" by auto}
  then have "\<forall>x1. isCont (\<lambda>x. (abs x)*y) x1"
    by blast
  then show ?thesis
    using continuous_at_imp_continuous_on
    by blast
qed

lemma real_abs_continuous:
  shows "continuous_on (UNIV::real set) abs"
proof -
  {fix x :: real
    have "isCont abs x"
    proof (cases "x>0")
      case True
      then have "abs x = x" by fastforce
      then show "isCont abs x"
        by simp
    next
      case False
      then have "abs x = -1 * x" by fastforce
      then show "isCont abs x"
        by simp
    qed}
  then show ?thesis
    using continuous_on_eq_continuous_at
    by blast
qed

lemma max_continuous:
  shows "continuous_on (UNIV::real set) max"
proof -
  {fix a :: real
    have "continuous_on UNIV (\<lambda>b. max a b)"
    proof -
      have 0:"{a..}\<union>{..a} = UNIV"
        by auto
      have 1:"continuous_on {a..} (\<lambda>b. if b \<ge> a then b else a)"
        using continuous_on_topological by fastforce
      have "continuous_on {..a} (\<lambda>b. if b \<ge> a then b else a)"
        using UNIV_I atMost_iff open_UNIV continuous_on_topological
        by (smt (verit, del_insts))
      then have "continuous_on UNIV (\<lambda>b. if b \<ge> a then b else a)"
        using 0 1 closed_atLeast closed_atMost continuous_on_closed_Un
        by (metis (no_types, lifting))
      then show ?thesis
        by (smt (z3))
    qed}
  {fix b :: real
    have "continuous_on UNIV (\<lambda>a. max a b)"
      by (meson \<open>\<And>a. continuous_on UNIV (max a)\<close> continuous_on_eq max.commute)}
  then show ?thesis
    using continuous_on_coordinatewise_then_product
    by blast
qed

lemma Max_gamma_continuous_gamma:
  fixes a b :: real
  shows "continuous_on UNIV (\<lambda>x. Max_gamma x a b)"
proof -
  have 0:"{0::real..}\<union>{..0} = UNIV"
    by auto
  have 1:"\<forall>x\<in>{x. x>0}. exp (a/x) + exp(b/x) \<noteq> 0"
    using add_pos_pos exp_gt_zero less_numeral_extra(3)
    by metis
  have 2:"\<And>\<gamma>. \<gamma>\<in>({x. x>0}) \<Longrightarrow> Max_gamma \<gamma> a b = \<gamma> * ln (exp (a /\<gamma>) + exp (b /\<gamma>))"
    by auto
  have 3:"open ((UNIV::real set)-{0})"
    by auto
  have 4:"open {x::real. x>0}"
    using equalityI greaterThan_iff mem_Collect_eq open_greaterThan subsetI
    by metis
  have "\<And>y::real. continuous_on {x. x>0} (\<lambda>x. exp (y/x))"
  proof -
    have "{x::real. x>0} \<subseteq> (UNIV-{0})"
      by blast
    then show "\<And>y::real. continuous_on {x. x>0} (\<lambda>x. exp (y/x))"
      using real_div_continuous continuous_on_exp continuous_on_subset
      by blast
  qed
  then have "continuous_on {x. x>0} (\<lambda>x. exp (a/x) + exp(b/x))"
    using continuous_on_add
    by blast
  then have 5:"continuous_on {x. x>0} (\<lambda>x. ln (exp (a/x) + exp(b/x)))"
    using continuous_on_ln 1
    by blast
  then have "continuous_on {x. x>0} (\<lambda>x. x * ln (exp (a/x) + exp(b/x)))"
    using continuous_on_id continuous_on_mult
    by blast
  then have 6:"continuous_on {x. x>0} (\<lambda>x. Max_gamma x a b)"
    using 4 2 continuous_on_cong
    by (metis (no_types, lifting))
  have 7:"\<forall>x\<in>{..0}. Max_gamma x a b = max a b"
    by simp
  then have "continuous_on {..0} (\<lambda>x. max a b)"
    using continuous_on_const
    by blast
  then have 8:"continuous_on {..0} (\<lambda>x. Max_gamma x a b)"
    using continuous_on_cong 7
    by metis
  have "(\<lambda>x. Max_gamma x a b) \<midarrow>0\<rightarrow> max a b"
    using Max_gamma_lim by blast
  then have "isCont (\<lambda>x. Max_gamma x a b) 0"
    using 7 isCont_def
    by fastforce
  then have "continuous_on {0..} (\<lambda>x. Max_gamma x a b)"
    using 6 4 continuous_at_imp_continuous_on continuous_on_eq_continuous_at mem_Collect_eq
      atLeast_iff
    by (smt (verit, ccfv_SIG))
  then show ?thesis
    using 0 8 continuous_on_closed_Un closed_atLeast closed_atMost
    by metis
qed

lemma Min_gamma_continuous_gamma:
  fixes a b :: real
  shows "continuous_on UNIV (\<lambda>x. Min_gamma x a b)"
proof -
  have 0:"{0::real..}\<union>{..0} = UNIV"
    by auto
  have 1:"\<forall>x\<in>{x. x>0}. exp (-a/x) + exp(-b/x) \<noteq> 0"
    using add_pos_pos exp_gt_zero less_numeral_extra(3)
    by metis
  have 2:"\<And>\<gamma>. \<gamma>\<in>({x. x>0}) \<Longrightarrow> Min_gamma \<gamma> a b = -\<gamma> * ln (exp (-a /\<gamma>) + exp (-b /\<gamma>))"
    by auto
  have 3:"open ((UNIV::real set)-{0})"
    by auto
  have 4:"open {x::real. x>0}"
    using equalityI greaterThan_iff mem_Collect_eq open_greaterThan subsetI
    by metis
  have "\<And>y::real. continuous_on {x. x>0} (\<lambda>x. exp (-y/x))"
  proof -
    have "{x::real. x>0} \<subseteq> (UNIV-{0})"
      by blast
    then show "\<And>y::real. continuous_on {x. x>0} (\<lambda>x. exp (-y/x))"
      using real_div_continuous continuous_on_exp continuous_on_subset
      by blast
  qed
  then have "continuous_on {x. x>0} (\<lambda>x. exp (-a/x) + exp(-b/x))"
    using continuous_on_add
    by blast
  then have 5:"continuous_on {x. x>0} (\<lambda>x. ln (exp (-a/x) + exp(-b/x)))"
    using continuous_on_ln 1
    by blast
  then have "continuous_on {x. x>0} (\<lambda>x. -x * ln (exp (-a/x) + exp(-b/x)))"
    using continuous_on_id continuous_on_mult continuous_on_minus
    by blast
  then have 6:"continuous_on {x. x>0} (\<lambda>x. Min_gamma x a b)"
    using 4 2 continuous_on_cong
    by (metis (no_types, lifting))
  have 7:"\<forall>x\<in>{..0}. Min_gamma x a b = min a b"
    by simp
  then have "continuous_on {..0} (\<lambda>x. min a b)"
    using continuous_on_const
    by blast
  then have 8:"continuous_on {..0} (\<lambda>x. Min_gamma x a b)"
    using continuous_on_cong 7
    by metis
  have "(\<lambda>x. Min_gamma x a b) \<midarrow>0\<rightarrow> min a b"
    using Min_gamma_lim by blast
  then have "isCont (\<lambda>x. Min_gamma x a b) 0"
    using 7 isCont_def
    by fastforce
  then have "continuous_on {0..} (\<lambda>x. Min_gamma x a b)"
    using 6 4 continuous_at_imp_continuous_on continuous_on_eq_continuous_at mem_Collect_eq
      atLeast_iff
    by (smt (verit, ccfv_SIG))
  then show ?thesis
    using 0 8 continuous_on_closed_Un closed_atLeast closed_atMost
    by metis
qed

lemma DERIV_fun_ln: "\<lbrakk> DERIV g (x::real) :> m; g x > 0 \<rbrakk> \<Longrightarrow> DERIV (\<lambda>x. ln (g x)) x :>  m/g x"
  by (simp add: DERIV_chain2 DERIV_ln divide_inverse_commute)

fun dAbs_a_minus_b_da :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dAbs_a_minus_b_da a b = (if a=b then (a-a) else (a-b)/(abs (a-b)))"

lemma dAbs_a_minus_b_da_equiv:"dAbs_a_minus_b_da a b = (if a=b then 0 else (a-b)/(abs (a-b)))" by simp

fun dAbs_a_minus_b_db :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dAbs_a_minus_b_db a b = (if a=b then (a-a) else (b-a)/(abs (a-b)))"

lemma dAbs_a_minus_b_db_equiv:"dAbs_a_minus_b_db a b = (if a=b then 0 else (b-a)/(abs (a-b)))" by simp

(* Max_gamma derivative *)

fun dMax_da :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dMax_da a b = (1::real)/((1::real)+(1::real))*((1::real) + (dAbs_a_minus_b_da a b))"

fun dMax_db :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dMax_db a b = (1::real)/((1::real)+(1::real))*((1::real) + (dAbs_a_minus_b_db a b))"

fun dMax_gamma_da :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMax_gamma_da \<gamma> a b = (if \<gamma> \<le> (0::real) then dMax_da a b
    else exp(a/\<gamma>)/(exp (a/\<gamma>) + exp (b/\<gamma>)))"

theorem max_gamma2_deriv_wrt_a:
  fixes x \<gamma> b :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "((\<lambda>y. Max_gamma \<gamma> y b) has_field_derivative dMax_gamma_da \<gamma> x b) (at x)"
proof -
  have "((\<lambda>y. exp(y/\<gamma>)) has_field_derivative (1/\<gamma>)*exp(x/\<gamma>)) (at x)"
    using DERIV_fun_exp [where g="\<lambda>y. y/\<gamma>" and m="1/\<gamma>"] by (simp add: DERIV_cdivide)
  moreover have "((\<lambda>y. exp(b/\<gamma>)) has_field_derivative 0) (at x)" by simp
  ultimately have sum_exp_diff: "((\<lambda>y. exp(y/\<gamma>) + exp(b/\<gamma>)) has_field_derivative (1/\<gamma>)*exp(x/\<gamma>)) (at x)"
    using DERIV_add by fastforce
  have "exp(x/\<gamma>) + exp(b/\<gamma>) > 0" by (simp add: pos_add_strict)
  hence "(ln has_real_derivative 1 / (exp(x/\<gamma>) + exp(b/\<gamma>))) (at (exp(x/\<gamma>) + exp(b/\<gamma>)))" using DERIV_ln_divide by simp
  from this and sum_exp_diff have "(ln \<circ> (\<lambda>y. exp(y/\<gamma>) + exp(b/\<gamma>)) has_field_derivative (exp(x/\<gamma>)/(\<gamma>*(exp(x/\<gamma>) + exp(b/\<gamma>))))) (at x)"
    using DERIV_chain by fastforce
  hence "((\<lambda>y. ln (exp(y/\<gamma>) + exp(b/\<gamma>))) has_field_derivative (exp(x/\<gamma>)/(\<gamma>*(exp(x/\<gamma>) + exp(b/\<gamma>))))) (at x)" by (simp add: o_def)
  hence "((\<lambda>y. \<gamma> * ln (exp(y/\<gamma>) + exp(b/\<gamma>))) has_field_derivative \<gamma>*(exp(x/\<gamma>)/(\<gamma>*(exp(x/\<gamma>) + exp(b/\<gamma>))))) (at x)" using DERIV_cmult by blast
  hence "((\<lambda>y. \<gamma> * ln (exp(y/\<gamma>) + exp(b/\<gamma>))) has_field_derivative (exp(x/\<gamma>)/(exp(x/\<gamma>) + exp(b/\<gamma>)))) (at x)" using gamma_gt_zero by force
  thus ?thesis using gamma_gt_zero by auto
qed

fun dMax_gamma_db :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMax_gamma_db \<gamma> a b = (if \<gamma> \<le> (0::real) then dMax_db a b
    else exp(b/\<gamma>)/(exp (a/\<gamma>) + exp (b/\<gamma>)))"

lemma Max_gamma_swap_indices:
  fixes \<gamma> c :: real
  shows "(\<lambda>y. Max_gamma \<gamma> c y) = (\<lambda>y. Max_gamma \<gamma> y c)"
  using Max_gamma_comm by auto

lemma dMax_gamma_swap_indices:
  fixes \<gamma> x c :: real
  assumes "\<gamma>>0"
  shows "dMax_gamma_da \<gamma> x c = dMax_gamma_db \<gamma> c x"
  using assms by auto

theorem max_gamma2_deriv_wrt_b:
  fixes x \<gamma> a :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "((\<lambda>y. Max_gamma \<gamma> a y) has_field_derivative dMax_gamma_db \<gamma> a x) (at x)"
using assms Max_gamma_swap_indices dMax_gamma_swap_indices by (metis max_gamma2_deriv_wrt_a)

fun dMax_gamma_ds :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMax_gamma_ds \<gamma> a da b db = (dMax_gamma_da \<gamma> a b) * da + (dMax_gamma_db \<gamma> a b) * db"

(* Min_gamma derivative *)

fun dMin_da :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dMin_da a b = (1::real)/((1::real)+(1::real))*((1::real) - (dAbs_a_minus_b_da a b))"

fun dMin_db :: "real \<Rightarrow> real \<Rightarrow> real"
  where "dMin_db a b = (1::real)/((1::real)+(1::real))*((1::real) - (dAbs_a_minus_b_db a b))"

fun dMin_gamma_da :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMin_gamma_da \<gamma> a b = (if \<gamma> \<le> (0::real) then dMin_da a b
    else exp(-a/\<gamma>)/(exp (-a/\<gamma>) + exp (-b/\<gamma>)))"

lemma Min_gamma_as_max:
  fixes \<gamma> a b :: real
  shows "Min_gamma \<gamma> a b = (-1) * Max_gamma \<gamma> (-a) (-b)"
  by force

lemma dMin_gamma_da_as_dMax:
  fixes \<gamma> a b :: real
  assumes "\<gamma>>0"
  shows "dMin_gamma_da \<gamma> a b = dMax_gamma_da \<gamma> (-a) (-b)"
  using assms by auto

theorem min_gamma2_deriv_wrt_a:
  fixes x \<gamma> b :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "((\<lambda>y. Min_gamma \<gamma> y b) has_field_derivative dMin_gamma_da \<gamma> x b) (at x)"
proof -
  from assms have "((\<lambda>y. Max_gamma \<gamma> y (-b)) has_field_derivative dMax_gamma_da \<gamma> (-x) (-b)) (at (-x))"
    using max_gamma2_deriv_wrt_a by blast
  moreover have "((\<lambda>y. -y) has_field_derivative (-1)) (at x)" using DERIV_minus DERIV_ident by blast
  ultimately have "((\<lambda>y. Max_gamma \<gamma> y (-b))\<circ>(\<lambda>y. -y) has_field_derivative (-1) * dMax_gamma_da \<gamma> (-x) (-b)) (at x)"
    using DERIV_chain by fastforce
  hence "((\<lambda>y. Max_gamma \<gamma> (-y) (-b)) has_field_derivative (-1) * dMax_gamma_da \<gamma> (-x) (-b)) (at x)"
    by (simp add: o_def)
  hence "((\<lambda>y. (-1) * Max_gamma \<gamma> (-y) (-b)) has_field_derivative dMax_gamma_da \<gamma> (-x) (-b)) (at x)"
    using DERIV_cmult [where c="-1" and f="(\<lambda>y. Max_gamma \<gamma> (-y) (-b))"] by fastforce
  thus ?thesis using gamma_gt_zero Min_gamma_as_max dMin_gamma_da_as_dMax by simp
qed

fun dMin_gamma_db :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMin_gamma_db \<gamma> a b = (if \<gamma> \<le> (0::real) then dMin_db a b
    else exp(-b/\<gamma>)/(exp (-a/\<gamma>) + exp (-b/\<gamma>)))"

lemma dMin_gamma_db_as_dMax:
  fixes \<gamma> a b :: real
  assumes "\<gamma>>0"
  shows "dMin_gamma_db \<gamma> a b = dMax_gamma_db \<gamma> (-a) (-b)"
  using assms by auto

lemma Min_gamma_swap_indices:
  fixes \<gamma> c :: real
  shows "(\<lambda>y. Min_gamma \<gamma> c y) = (\<lambda>y. Min_gamma \<gamma> y c)"
  using Min_gamma_comm by auto

lemma dMin_gamma_swap_indices:
  fixes \<gamma> x c :: real
  assumes "\<gamma>>0"
  shows "dMin_gamma_da \<gamma> x c = dMin_gamma_db \<gamma> c x"
  using assms by auto

theorem min_gamma2_deriv_wrt_b:
  fixes x \<gamma> a :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "((\<lambda>y. Min_gamma \<gamma> a y) has_field_derivative dMin_gamma_db \<gamma> a x) (at x)"
using assms Min_gamma_swap_indices dMin_gamma_swap_indices by (metis min_gamma2_deriv_wrt_a)

fun dMin_gamma_ds :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
  "dMin_gamma_ds \<gamma> a da b db = (dMin_gamma_da \<gamma> a b) * da + (dMin_gamma_db \<gamma> a b) * db"

theorem dMax_gamma_chain:
  fixes f g :: "real \<Rightarrow> real" and Df Dg \<gamma> :: real
  assumes "\<gamma> > 0"
  and "(f has_real_derivative Df) (at x)"
and "(g has_real_derivative Dg) (at x)"
shows "((\<lambda>y. (Max_gamma_comp \<gamma> (f y) (g y))) has_real_derivative (dMax_gamma_ds \<gamma> (f x) Df (g x) Dg)) (at x)"
proof -
  have "((\<lambda>x. exp (f x / \<gamma>)) has_real_derivative exp (f x / \<gamma>) * Df / \<gamma>) (at x)"
    using assms  DERIV_fun_exp [OF DERIV_divide, of f Df x "\<lambda>x. \<gamma>" 0]
    by simp
  moreover have "((\<lambda>x. exp (g x / \<gamma>)) has_real_derivative exp (g x / \<gamma>) * Dg / \<gamma>) (at x)"
    using assms DERIV_fun_exp [OF DERIV_divide, of g Dg x "\<lambda>x. \<gamma>" 0]
    by simp
  ultimately have "((\<lambda>y. ln (exp (f y / \<gamma>) + exp (g y / \<gamma>))) has_real_derivative
     (exp (f x / \<gamma>) * Df/\<gamma> + exp (g x / \<gamma>) * Dg/\<gamma>) / (exp (f x / \<gamma>) + exp (g x / \<gamma>))) (at x)"
    by (auto intro!: DERIV_fun_ln DERIV_add simp add: add_pos_pos)
  then have "((\<lambda>y. \<gamma> * ln (exp (f y / \<gamma>) + exp (g y / \<gamma>))) has_real_derivative
     \<gamma> * (exp (f x / \<gamma>) * Df/\<gamma> + exp (g x / \<gamma>) * Dg/\<gamma>) / (exp (f x / \<gamma>) + exp (g x / \<gamma>))) (at x)"
    using DERIV_cmult by fastforce
  then have "((\<lambda>y. \<gamma> * ln (exp (f y / \<gamma>) + exp (g y / \<gamma>))) has_real_derivative
     (exp (f x / \<gamma>) * Df + exp (g x / \<gamma>) * Dg) / (exp (f x / \<gamma>) + exp (g x / \<gamma>))) (at x)"
    using assms(1)
    by (metis (no_types, lifting) add_divide_distrib less_irrefl nonzero_mult_div_cancel_left times_divide_eq_right)
  then show ?thesis unfolding Max_gamma_comp_eq using assms(1) by (simp add: add_divide_distrib)
qed

theorem dMin_gamma_chain:
  fixes f g :: "real \<Rightarrow> real" and Df Dg \<gamma> x :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  and f_deriv: "(f has_real_derivative Df) (at x)"
and g_deriv: "(g has_real_derivative Dg) (at x)"
shows "((\<lambda>y. (Min_gamma_comp \<gamma> (f y) (g y))) has_real_derivative (dMin_gamma_ds \<gamma> (f x) Df (g x) Dg)) (at x)"
proof -
  let ?n_f = "(\<lambda>y. (-1) * f y)"
  let ?n_g = "(\<lambda>y. (-1) * g y)"
  from f_deriv have "(?n_f has_real_derivative (-1)*Df) (at x)" using DERIV_cmult by blast
  moreover from g_deriv have "(?n_g has_real_derivative (-1)*Dg) (at x)" using DERIV_cmult by blast
  ultimately have deriv: "((\<lambda>y. (Max_gamma_comp \<gamma> (?n_f y) (?n_g y))) has_real_derivative
  (dMax_gamma_ds \<gamma> (?n_f x) (-Df) (?n_g x) (-Dg))) (at x)" using gamma_gt_zero dMax_gamma_chain by fastforce
  have "(\<lambda>y. (Min_gamma_comp \<gamma> (f y) (g y))) = (\<lambda>y. (-1)*(Max_gamma_comp \<gamma> (?n_f y) (?n_g y)))"
    using Max_gamma_comp_eq Min_gamma_comp_eq by force
  from this and deriv have "((\<lambda>y. (Min_gamma_comp \<gamma> (f y) (g y))) has_real_derivative
  (-1)*(dMax_gamma_ds \<gamma> (?n_f x) (-Df) (?n_g x) (-Dg))) (at x)"
    using Deriv.field_differentiable_minus by fastforce
  moreover have "(-1)*(dMax_gamma_ds \<gamma> (?n_f x) (-Df) (?n_g x) (-Dg))
= (-1)*((dMax_gamma_da \<gamma> (?n_f x) (?n_g x))*(-Df) + (dMax_gamma_db \<gamma> (?n_f x) (?n_g x))*(-Dg))" by simp
  hence "(-1)*(dMax_gamma_ds \<gamma> (?n_f x) (-Df) (?n_g x) (-Dg))
= (dMin_gamma_ds \<gamma> (f x) Df (g x) Dg)"
    using dMin_gamma_db_as_dMax dMin_gamma_da_as_dMax gamma_gt_zero by fastforce
  ultimately show  ?thesis using DERIV_cong by simp
qed

lemma min_continuous:
  shows "continuous_on (UNIV::real set) min"
proof -
  {fix a :: real
    have "continuous_on UNIV (\<lambda>b. min a b)"
    proof -
      have 0:"{a..}\<union>{..a} = UNIV"
        by auto
      have 1:"continuous_on {..a} (\<lambda>b. if a \<le> b then a else b)"
        using continuous_on_topological atMost_iff
        by (smt (verit, best))
      have "continuous_on {a..} (\<lambda>b. if a \<le> b then a else b)"
        using UNIV_I open_UNIV continuous_on_topological atLeast_iff
        by (smt (verit, best))
      then have "continuous_on UNIV (\<lambda>b. if a \<le> b then a else b)"
        using 0 1 closed_atLeast closed_atMost continuous_on_closed_Un
        by (metis (no_types, lifting))
      then show ?thesis
        by (smt (z3))
    qed}
  {fix b :: real
    have "continuous_on UNIV (\<lambda>a. min a b)"
      by (meson \<open>\<And>a. continuous_on UNIV (min a)\<close> continuous_on_eq min.commute)}
  then show ?thesis
    using continuous_on_coordinatewise_then_product
    by blast
qed

lemma Max_gamma_continuous_a:
  fixes \<gamma> b :: real
  shows "continuous_on UNIV (\<lambda>y. Max_gamma \<gamma> y b)"
proof (cases "\<gamma>>0")
  case True
  then show ?thesis
    using max_gamma2_deriv_wrt_a DERIV_continuous continuous_on_eq_continuous_within
    by metis
next
  case False
  then have "(\<lambda>y. Max_gamma \<gamma> y b) = (\<lambda>y. max y b)"
    by simp
  then show ?thesis
    using max_continuous continuous_on_product_then_coordinatewise_UNIV
    by metis
qed

lemma Max_gamma_continuous_b:
  fixes \<gamma> a :: real
  shows "continuous_on UNIV (\<lambda>y. Max_gamma \<gamma> a y)"
proof (cases "\<gamma>>0")
  case True
  then show ?thesis
    using max_gamma2_deriv_wrt_b DERIV_continuous_on
    by metis
next
  case False
  then have "(\<lambda>y. Max_gamma \<gamma> a y) = (\<lambda>y. max a y)"
    by simp
  then show ?thesis
    using max_continuous continuous_on_product_then_coordinatewise_UNIV continuous_on_cong
    by (smt (verit, best))
qed

lemma Max_gamma_continuous_ab:
  fixes \<gamma> :: real
  shows "continuous_on UNIV (\<lambda>x y. Max_gamma \<gamma> x y)"
  using Max_gamma_continuous_a Max_gamma_continuous_b continuous_on_coordinatewise_then_product
  by metis

lemma Max_gamma_continuous:"continuous_on UNIV Max_gamma"
  using Max_gamma_continuous_ab Max_gamma_continuous_gamma
    continuous_on_coordinatewise_then_product
  by metis

lemma Min_gamma_continuous_a:
  fixes \<gamma> b :: real
  shows "continuous_on UNIV (\<lambda>y. Min_gamma \<gamma> y b)"
proof (cases "\<gamma>>0")
  case True
  then show ?thesis
    using min_gamma2_deriv_wrt_a DERIV_continuous continuous_on_eq_continuous_within
    by metis
next
  case False
  then have "(\<lambda>y. Min_gamma \<gamma> y b) = (\<lambda>y. min y b)"
    by simp
  then show ?thesis
    using min_continuous continuous_on_product_then_coordinatewise_UNIV
    by metis
qed

lemma Min_gamma_continuous_b:
  fixes \<gamma> a :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "continuous_on UNIV (\<lambda>y. Min_gamma \<gamma> a y)"
  using assms min_gamma2_deriv_wrt_b DERIV_continuous_on
  by metis

lemma Min_gamma_continuous_ab:
  fixes \<gamma> :: real
  assumes gamma_gt_zero: "\<gamma> > 0"
  shows "continuous_on UNIV (\<lambda>x y. Min_gamma \<gamma> x y)"
  using Min_gamma_continuous_a Min_gamma_continuous_b
  using assms continuous_on_coordinatewise_then_product
  by metis

lemma Min_gamma_continuous:"continuous_on UNIV (\<lambda>\<gamma> x y. Min_gamma \<gamma> x y)"
  using Min_gamma_continuous_ab Min_gamma_continuous_gamma
    continuous_on_coordinatewise_then_product
  by metis

lemma Max_gamma_works_chain:
  fixes \<epsilon> \<gamma> s :: real and f g :: "real \<Rightarrow> real"
  assumes "f \<midarrow>0\<rightarrow> L" "g \<midarrow>0\<rightarrow> M" "0<\<epsilon>" "0<\<gamma>"
    "s = (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < \<epsilon>/2))"
    "\<gamma> < min (\<epsilon>/(2 * ln 2)) s"
  shows "\<bar>Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max L M\<bar> < \<epsilon>"
proof -
  fix s2 :: real
  have eps_pos2:"\<epsilon>/2>0" using assms by simp
  then have eps_pos22:"\<epsilon>/(2 * ln 2)>0" by simp
  have "(\<lambda>\<gamma>. max (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> max L M"
    using tendsto_max assms(1) assms(2)
    by blast
  then have max_lim:"\<exists>s. s \<in> {s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < \<epsilon>/2)}"
    using eps_pos2 LIM_eq [where ?f="\<lambda>\<gamma>. max (f \<gamma>) (g \<gamma>)" and ?a="0" and ?L="max L M"]
    by blast
  then have s_defn:"\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < \<epsilon>/2"
    using assms(5)
    by (metis (mono_tags, lifting) mem_Collect_eq someI)
  have s2_less2:"\<gamma> < (\<epsilon>/(2 * ln 2))" using assms by simp
  obtain c::real and d::real where cd_defn:"c = max (f \<gamma>) (g \<gamma>) \<and> d = min (f \<gamma>) (g \<gamma>)" by simp
  have "(c = (f \<gamma>) \<and> d = (g \<gamma>)) \<or> (c = (g \<gamma>) \<and> d = (f \<gamma>))" using cd_defn by auto
  then have 1:"Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) = Max_gamma \<gamma> d c" using Max_gamma_comm by blast
  have 2:"\<And>x::real. exp x > 0" by simp
  have "d\<le>c" using cd_defn by simp
  then have 21:"exp (d/\<gamma>) \<le> exp (c/\<gamma>)" using assms  divide_right_mono by fastforce
  then have 3:"exp (d/\<gamma>)/exp (c/\<gamma>) \<le> 1" by simp
  then have 31:"exp (d/\<gamma>)/exp (c/\<gamma>) > 0" by simp
  have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c = \<gamma> * (ln (exp (d/\<gamma>) + exp (c/\<gamma>))) - c" using 1  assms by simp
  also have 4:"Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c = \<gamma> * (ln ((exp (d/\<gamma>)/exp(c/\<gamma>))*exp(c/\<gamma>) + exp (c/\<gamma>))) - c"
    using calculation by auto
  moreover have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c \<le> \<gamma> * (ln (exp(c/\<gamma>) + exp (c/\<gamma>))) - c" using 3
    by (smt calculation(2) divide_nonneg_nonneg  ln_less_cancel_iff mult_left_le_one_le
        nonzero_eq_divide_eq not_exp_le_zero ordered_comm_semiring_class.comm_mult_left_mono assms)
  moreover have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c \<le> \<gamma> * (ln (2 * exp (c/\<gamma>))) - c" using calculation(3) by auto
  moreover have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c \<le> \<gamma> * (ln 2 + ln (exp (c/\<gamma>))) - c"
    using ln_mult 2 calculation(3) by auto
  moreover have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c \<le> \<gamma> * ln 2 + \<gamma> * c/\<gamma> - c"
    by (metis (no_types, opaque_lifting) calculation(5) div_by_1 divide_divide_eq_right ln_exp
        mult.left_neutral ring_class.ring_distribs(1))
  ultimately have 5:"Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c \<le> \<gamma> * ln 2"
    using  assms by auto
  have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c > \<gamma> * (ln (exp (c/\<gamma>))) - c" using 31 4
    by (smt (verit, best)  ln_less_cancel_iff mult_le_cancel_left_pos mult_pos_pos not_exp_le_zero assms)
  moreover have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c > \<gamma> * c/\<gamma> - c" using calculation by auto
  ultimately have 6:"Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - c > 0" using  assms by auto
  have "Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max (f \<gamma>) (g \<gamma>) \<le> \<gamma> * ln 2 \<and> Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max (f \<gamma>) (g \<gamma>) > 0"
    using cd_defn 5 6 by simp
  then have 7:"\<bar>Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max (f \<gamma>) (g \<gamma>)\<bar> \<le> \<epsilon>/2"
    using s2_less2
    by (simp add: less_divide_eq)
  then have "\<gamma> < s"
    using  assms
    by argo
  then have "\<gamma>>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) \<le> \<gamma> \<longrightarrow> (norm (max (f x) (g x) - max L M) < \<epsilon>/2))"
    using assms s_defn
    by simp
  then have "norm (max (f \<gamma>) (g \<gamma>) - max L M) < \<epsilon>/2"
    by auto
  then have fineq:"norm (max (f \<gamma>) (g \<gamma>) - max L M) < \<epsilon>/2
    \<and> norm (Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max (f \<gamma>) (g \<gamma>)) \<le> \<epsilon>/2"
    using 7 by simp
  then have "\<bar>Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max L M\<bar> \<le> \<bar>max (f \<gamma>) (g \<gamma>) - max L M\<bar>
      + \<bar>Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max (f \<gamma>) (g \<gamma>)\<bar>"
    by argo
  then show "\<bar>Max_gamma \<gamma> (f \<gamma>) (g \<gamma>) - max L M\<bar> < \<epsilon>"
    using fineq
    by auto
qed

lemma Max_gamma_works_chain2:
  fixes f g :: "real \<Rightarrow> real"
  assumes "f \<midarrow>0\<rightarrow> L" "g \<midarrow>0\<rightarrow> M"
  shows "(\<forall>r>0. \<forall>x. x > 0 \<and> x < min (r/(2 * ln 2)) (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2)) \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) x - max L M\<bar> < r)"
proof -
  {fix r \<gamma> :: real
    assume 1:"r>0"
    assume 2:"\<gamma>>0"
    then have "(\<gamma> < min (r/(2 * ln 2)) (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2)) \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) \<gamma> - max L M\<bar> < r)"
      using 1 assms Max_gamma_works_chain [where ?\<epsilon>="r" and ?s="(SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
      \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2))" and ?f="f" and ?g="g" and ?L="L" and ?M="M" and ?\<gamma>="\<gamma>"]
      by presburger}
  then show ?thesis by presburger
qed

lemma Max_gamma_lim_chain:
  fixes f g :: "real \<Rightarrow> real"
  assumes flim:"f \<midarrow>0\<rightarrow> L" and glim:"g \<midarrow>0\<rightarrow> M" and
    f_const_bel0:"\<forall>x\<le>0. f x = L" and g_const_bel0:"\<forall>x\<le>0. g x = M"
  shows "(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> max L M"
proof -
  have "(\<lambda>\<gamma>. max (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> max L M"
    using tendsto_max assms(1) assms(2)
    by blast
  then have max_lim:"\<And>r. r>0 \<Longrightarrow> (\<exists>s. s \<in> {s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < r)})"
    using LIM_eq [where ?f="\<lambda>\<gamma>. max (f \<gamma>) (g \<gamma>)" and ?a="0" and ?L="max L M"]
    by simp
  have 1:"\<forall>(r::real)>0. (r/(2 * ln 2)) > 0" by simp
  have 2:"\<And>s. \<forall>r>0. s \<in> {s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < r)} \<longrightarrow> s > 0"
    using max_lim by blast
  have 3:"\<forall>r>0. \<exists>x. x>0 \<and> x < min (r/(2 * ln 2)) (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2))"
  proof -
    {fix s r :: real
      assume "r>0"
      then have "r/2>0" by simp
      assume s_defn:"s=(SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2))"
      then have "s \<in> {s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2)}"
        using max_lim [where ?r="r/2"] \<open>r/2>0\<close>  mem_Collect_eq someI
        by (metis (no_types, lifting))
      then have "s>0"
        by blast
      then have "\<exists>x. x>0 \<and> x < min (r/(2 * ln 2)) s"
        using 1 dense \<open>r>0\<close>
        by (simp add: \<open>0 < r\<close> field_lbound_gt_zero)}
    then have "\<And>r. r>0 \<Longrightarrow> \<exists>x. x>0 \<and> x < min (r/(2 * ln 2)) (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2))"
      by meson
    then show ?thesis
      by blast
  qed
  have 4:"\<And>(x::real) (s::real). s>0 \<Longrightarrow> (x>0\<and>x<s \<longrightarrow> x\<noteq>0 \<and> norm (x - 0) < s)"
    by auto
  have "(\<forall>r>0. \<forall>x. x > 0 \<and> x < min (r/(2 * ln 2)) (SOME s. s>0 \<and> (\<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s
    \<longrightarrow> norm (max (f x) (g x) - max L M) < r/2))  \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) x - max L M\<bar> < r)"
    using Max_gamma_works_chain2 assms
    by presburger
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x > 0 \<and> x < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) x - max L M\<bar> < r"
    using ln_gt_zero one_less_numeral_iff semiring_norm(76) zero_less_divide_iff max_lim 3
    by force
  then have "\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> \<bar>(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) x - max L M\<bar> < r"
    using 4 f_const_bel0 g_const_bel0
    by force
  then have 1:"\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow> norm ((\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) x - (max L M)) < r"
    by simp
  then show ?thesis
    using LIM_eq by blast
qed

lemma Min_gamma_lim_chain:
  fixes f g :: "real \<Rightarrow> real"
  assumes flim:"f \<midarrow>0\<rightarrow> L" and glim:"g \<midarrow>0\<rightarrow> M" and
    f_const_bel0:"\<forall>x\<le>0. f x = L" and g_const_bel0:"\<forall>x\<le>0. g x = M"
  shows "(\<lambda>\<gamma>. Min_gamma \<gamma> (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> min L M"
proof -
  have 00:"\<And>(a::real) b. min a b = -(max (-a) (-b))"
    by auto
  have 0:"(\<lambda>x. -(f x)) \<midarrow>0\<rightarrow> -L \<and> (\<lambda>x. -(g x)) \<midarrow>0\<rightarrow> -M"
    using tendsto_minus flim glim
    by auto
  have "\<And>g a b. Min_gamma g a b = -(Max_gamma g (-a) (-b))"
    by auto
  then have 1:"\<And>\<gamma>. (\<lambda>\<gamma>. Min_gamma \<gamma> (f \<gamma>) (g \<gamma>)) = (\<lambda>\<gamma>. -(Max_gamma \<gamma> (-(f \<gamma>)) (-(g \<gamma>))))"
    by auto
  then have "(\<lambda>\<gamma>. Max_gamma \<gamma> (-(f \<gamma>)) (-(g \<gamma>))) \<midarrow>0\<rightarrow> max (-L) (-M)"
    using 0 Max_gamma_lim_chain assms
    by presburger
  then have "(\<lambda>\<gamma>. -(Max_gamma \<gamma> (-(f \<gamma>)) (-(g \<gamma>)))) \<midarrow>0\<rightarrow> -(max (-L) (-M))"
    by (simp add: tendsto_minus)
  then show ?thesis
    using 00 1
    by presburger
qed

lemma Max_gamma_cont_0:
  fixes a b :: real
  shows "isCont (\<lambda>\<gamma>. Max_gamma \<gamma> a b) 0"
  using Max_gamma_continuous_gamma UNIV_I continuous_on_eq_continuous_within
  by metis

lemma Max_gamma_const_bel0:
  fixes a b :: real
  shows "\<forall>x\<le>0. Max_gamma x a b = Max_gamma 0 a b"
  by simp

lemma Min_gamma_cont_0:
  fixes a b :: real
  shows "isCont (\<lambda>\<gamma>. Min_gamma \<gamma> a b) 0"
  using Min_gamma_continuous_gamma UNIV_I continuous_on_eq_continuous_within
  by metis

lemma Min_gamma_const_bel0:
  fixes a b :: real
  shows "\<forall>x\<le>0. Min_gamma x a b = Min_gamma 0 a b"
  by simp

lemma Max_gamma_chain_cont_0:
  fixes f g :: "real \<Rightarrow> real"
  assumes "isCont f 0" "isCont g 0" "\<forall>x\<le>0. f x = f 0" "\<forall>x\<le>0. g x = g 0"
  shows "isCont (\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) 0"
proof -
  have "f \<midarrow>0\<rightarrow> f 0 \<and> g \<midarrow>0\<rightarrow> g 0"
    using assms isCont_def
    by blast
  then have "(\<lambda>\<gamma>. Max_gamma \<gamma> (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> max (f 0) (g 0)"
    using Max_gamma_lim_chain assms
    by blast
  then show ?thesis using isCont_def
    by fastforce
qed

lemma Min_gamma_chain_cont_0:
  fixes f g :: "real \<Rightarrow> real"
  assumes "isCont f 0" "isCont g 0" "\<forall>x\<le>0. f x = f 0" "\<forall>x\<le>0. g x = g 0"
  shows "isCont (\<lambda>\<gamma>. Min_gamma \<gamma> (f \<gamma>) (g \<gamma>)) 0"
proof -
  have "f \<midarrow>0\<rightarrow> f 0 \<and> g \<midarrow>0\<rightarrow> g 0"
    using assms isCont_def
    by blast
  then have "(\<lambda>\<gamma>. Min_gamma \<gamma> (f \<gamma>) (g \<gamma>)) \<midarrow>0\<rightarrow> min (f 0) (g 0)"
    using Min_gamma_lim_chain assms
    by blast
  then show ?thesis using isCont_def
    by fastforce
qed

lemma Max_gamma_chain_const_bel0:
  fixes f g :: "real \<Rightarrow> real"
  assumes "\<forall>x\<le>0. f x = f 0" "\<forall>x\<le>0. g x = g 0"
  shows "\<forall>x\<le>0. Max_gamma x (f x) (g x) = Max_gamma 0 (f 0) (g 0)"
  using Max_gamma_const_bel0 assms(1) assms(2) by presburger

lemma Min_gamma_chain_const_bel0:
  fixes f g :: "real \<Rightarrow> real"
  assumes "\<forall>x\<le>0. f x = f 0" "\<forall>x\<le>0. g x = g 0"
  shows "\<forall>x\<le>0. Min_gamma x (f x) (g x) = Min_gamma 0 (f 0) (g 0)"
  using Min_gamma_const_bel0 assms(1) assms(2) by presburger

end


theory Prog_Prove_3_3
  imports Main
begin
lemma "\<forall>x. \<exists>y. x = y"
  by auto

lemma "\<lbrakk>\<forall>xs \<in> A. \<exists>ys. xs = ys @ ys; us \<in> A \<rbrakk> \<Longrightarrow> \<exists>n. length us = n + n"
  by fastforce

lemma "\<lbrakk>\<forall>x y. T x y \<or> T y x;
        \<forall>x y. A x y \<and> A y x \<longrightarrow> x = y;
        \<forall>x y. T x y \<longrightarrow> A x y\<rbrakk>
        \<Longrightarrow> \<forall> x y. A x y \<longrightarrow> T x y"
  by blast

lemma "\<lbrakk> xs @ ys = ys @ xs; length xs = length ys \<rbrakk> \<Longrightarrow> xs = ys "
  using append_eq_append_conv by blast

end


theory Homework6_2sol
imports Main "~~/src/HOL/Eisbach/Eisbach"
begin

(*
  We extend IMP by arrays.
  Each variable is now a list of integers, and variable
  access takes an additional index.
*)

type_synonym vname = string
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val list"

datatype aexp = N int | V vname aexp | Plus aexp aexp

(*
  Unfortunately, array access may be out of bounds.
  Thus, we model evaluation of expressions as partial function,
  returning None if array index is out of bounds.
*)

(* Give case for variable! Note:
  l!i selects the ith element of list l,
  and nat converts an int to a nat.
*)
fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val option" where
"aval (N n) s = Some n" |
"aval (V x i) s = (
  case aval i s of
    None \<Rightarrow> None
  | Some i \<Rightarrow> (
      if 0\<le>i \<and> nat i<length (s x) then
        Some (s x ! nat i)
      else None)
  )" |
"aval (Plus a\<^sub>1 a\<^sub>2) s = (
  case aval a\<^sub>1 s of
    None \<Rightarrow> None
  | Some r1 \<Rightarrow> (
      case aval a\<^sub>2 s of
        None \<Rightarrow> None
      | Some r2 \<Rightarrow> Some (r1+r2)))
      "

text {* A little syntax magic to write larger states compactly: *}

(* All variables are arrays of length 1, initialized by zero.
  This simulates the behaviour of original IMP.
*)
definition null_state ("<>") where
  "null_state \<equiv> \<lambda>x. [0]"
syntax
  "_State" :: "updbinds => 'a" ("<_>")
translations
  "_State ms" == "_Update <> ms"
  "_State (_updbinds b bs)" <= "_Update (_State b) bs"

lemma null_state_app[simp]: "<> x = [0]" by (auto simp: null_state_def)

abbreviation "V0 x \<equiv> V x (N 0)" (* Abbreviation for x[0].
  Again, models the behaviour of original IMP. *)

(* Test cases *)
value "aval (Plus (V ''x'' (V0 ''y'')) (V ''x'' (N 1))) <''x'':=[1,2,3], ''y'':=[2]> = Some 5"
value "aval (Plus (N 2) (V ''x'' (N 2))) <''x'':=[1,2]> = None" (* Index out of bounds *)

datatype bexp = Bc bool | Not bexp | And bexp bexp | Less aexp aexp

fun bval :: "bexp \<Rightarrow> state \<Rightarrow> bool option" where
"bval (Bc v) s = Some v" |
"bval (Not b) s = (case bval b s of None \<Rightarrow> None | Some b \<Rightarrow> Some (\<not>b))" |
(*<*)
"bval (And b\<^sub>1 b\<^sub>2) s = (case bval b\<^sub>1 s of
    None \<Rightarrow> None
  | Some r1 \<Rightarrow> (case bval b\<^sub>2 s of
      None \<Rightarrow> None
    | Some r2 \<Rightarrow> Some (r1 \<and> r2))
  )" |
"bval (Less a\<^sub>1 a\<^sub>2) s = (case aval a\<^sub>1 s of
    None \<Rightarrow> None
  | Some r1 \<Rightarrow> (case aval a\<^sub>2 s of
      None \<Rightarrow> None
    | Some r2 \<Rightarrow> Some (r1<r2)))"
(*>*)

datatype
  com = SKIP
      | Assign vname aexp aexp  ("_[_] ::= _" [1000,900, 61] 61)
      | Seq    com  com         ("_;;/ _"  [60, 61] 60)
      | If     bexp com com     ("(IF _/ THEN _/ ELSE _)"  [0, 0, 61] 61)
      | While  bexp com         ("(WHILE _/ DO _)"  [0, 61] 61)

(* Abbreviation to get x ::= e syntax, as abbreviation for x[N 0] ::= e *)
abbreviation Assign0 ("_ ::= _" [1000, 61] 61) where
  "x ::= v \<equiv> (x[N 0] ::= v)"

(*
  Give Skip,Assign,Seq rule.

  The big-step semantics shall get stuck in case of array-index-out-of-bounds.
  That is, the preconditions of the rules assume that the indexes are in bounds,
  and that aval/bval return Some result.

  Note: l[i:=v] replaces ith element of list l by v
*)
inductive
  big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where
Skip: "(SKIP,s) \<Rightarrow> s" |
Assign: "\<lbrakk>
  aval a s = Some v;
  aval i s = Some idx;
  0\<le>idx;
  nat idx<length (s x) \<rbrakk>
\<Longrightarrow> (x[i] ::= a,s) \<Rightarrow> s(x := ((s x)[nat idx := v]))" |
Seq: "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
(*<*)
IfTrue: "\<lbrakk> bval b s = Some True;  (c\<^sub>1,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
IfFalse: "\<lbrakk> bval b s = Some False;  (c\<^sub>2,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
WhileFalse: "bval b s = Some False \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> s" |
WhileTrue:
"\<lbrakk> bval b s\<^sub>1 = Some True;  (c,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
\<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3"
(*>*)

(* Setup for program derivation *)
method If = (rule IfTrue, (simp;fail)) | (rule IfFalse, (simp;fail))
method While = (rule WhileTrue, (simp;fail)) | (rule WhileFalse, (simp;fail))
method BigStep = simp?; ((rule Skip Assign Seq) | If | While)
method BigSteps = BigStep+

(* Automation setup *)
declare big_step.intros [intro]

lemmas big_step_induct = big_step.induct[split_format(complete)]

inductive_cases SkipE[elim!]: "(SKIP,s) \<Rightarrow> t"

inductive_cases AssignE[elim!]: "(x[i] ::= a,s) \<Rightarrow> t"
thm AssignE
inductive_cases SeqE[elim!]: "(c1;;c2,s1) \<Rightarrow> s3"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> t"
thm IfE
inductive_cases WhileE[elim]: "(WHILE b DO c,s) \<Rightarrow> t"
thm WhileE

(* Proof should not change ... *)
lemma Seq_assoc:
  "(c1;; c2;; c3, s) \<Rightarrow> s' \<longleftrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> s'"
proof
  assume "(c1;; c2;; c3, s) \<Rightarrow> s'"
  then obtain s1 s2 where
    c1: "(c1, s) \<Rightarrow> s1" and
    c2: "(c2, s1) \<Rightarrow> s2" and
    c3: "(c3, s2) \<Rightarrow> s'" by auto
  from c2 c3
  have "(c2;; c3, s1) \<Rightarrow> s'" by (rule Seq)
  with c1
  show "(c1;; (c2;; c3), s) \<Rightarrow> s'" by (rule Seq)
next
  -- "The other direction is analogous"
  assume "(c1;; (c2;; c3), s) \<Rightarrow> s'"
  thus "(c1;; c2;; c3, s) \<Rightarrow> s'" by auto
qed

(*
  You will probably have to perform an Isar-proof here, or try to fiddle
  through with sledgehammer.
  The problem is that the induction generates goals like

  \<And>b s c\<^sub>1 t c\<^sub>2 u.
     \<lbrakk> bval b s = Some True;
      (c\<^sub>1, s) \<Rightarrow> t;
      \<And>u. (c\<^sub>1, s) \<Rightarrow> u \<Longrightarrow> u = t;
      (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> u
     \<rbrakk>
     \<Longrightarrow> u = t

  This will crash the simplifier, which uses the 2nd and 3rd premise to rewrite with t=t.
  In the Isar-proof, try to only use the necessary premises \<dots>
*)

theorem big_step_determ: "\<lbrakk> (c,s) \<Rightarrow> t; (c,s) \<Rightarrow> u \<rbrakk> \<Longrightarrow> u = t"
proof (induction arbitrary: u rule: big_step.induct)
  case (Skip s)
  then show ?case by auto
next
  case (Assign a s v i idx x)
  then show ?case by auto
next
  case (Seq c\<^sub>1 s\<^sub>1 s\<^sub>2 c\<^sub>2 s\<^sub>3)
  then show ?case by blast
next
  case (IfTrue b s c\<^sub>1 t c\<^sub>2)
  from IfTrue.prems IfTrue.hyps(1) IfTrue.IH
  show ?case by auto
next
  case (IfFalse b s c\<^sub>2 t c\<^sub>1)
  from IfFalse.prems IfFalse.hyps(1) IfFalse.IH
  show ?case by auto
next
  case (WhileFalse b s c)
  then show ?case by auto
next
  case (WhileTrue b s\<^sub>1 c s\<^sub>2 s\<^sub>3)
  from WhileTrue.prems \<open>bval b s\<^sub>1 = Some True\<close> WhileTrue.IH(1) have
    "(WHILE b DO c, s\<^sub>2) \<Rightarrow> u" by auto
  with WhileTrue.IH(2) show ?case by simp
qed

(*
  Write a program that sums up the elements from l..<h of array a, and
  returns the result in r.

  Hint:
    r=0;
    while (l<h) r+=a[l++];

*)

abbreviation "array_sum \<equiv>
  ''r'' ::= N 0;;
  WHILE Less (V0 ''l'') (V0 ''h'') DO (
    ''r'' ::= Plus (V0 ''r'') (V ''a'' (V0 ''l''));;
    ''l'' ::= Plus (V0 ''l'') (N 1)
  )"

(* Use automatic big-step derivation to test your program!
  Note that the BigSteps method will fail to generate a derivation if
  execution gets stuck b/c index-out-of-bounds
*)

schematic_goal "(array_sum,<''l'':=[1], ''h'':=[5], ''a'':=[100,1,2,3,4,200,300]>) \<Rightarrow> ?s"
  by BigSteps

(*
  Write another program that sums up only the elements >5 of array a,
  in between l..<h, and returns the result in r.
  Test your program!

  Hint: Start with the array_sum program and extend it.
*)

abbreviation "array_sum_gt5 \<equiv>
  ''r'' ::= N 0;;
  WHILE Less (V0 ''l'') (V0 ''h'') DO (
    IF Less (N 5) (V ''a'' (V0 ''l'')) THEN
      ''r'' ::= Plus (V0 ''r'') (V ''a'' (V0 ''l''))
    ELSE SKIP;;
    ''l'' ::= Plus (V0 ''l'') (N 1)
  )"

schematic_goal "(array_sum_gt5,<''l'':=[1], ''h'':=[5], ''a'':=[100,1,7,13,4,200,300]>) \<Rightarrow> ?s"
  by BigSteps

end


section{*Examples of Reasoning in ZF Set Theory*}

theory ZF_examples imports Main_ZFC begin

subsection {* Binary Trees *}

consts
  bt :: "i => i"

datatype "bt(A)" =
  Lf | Br ("a \<in> A", "t1 \<in> bt(A)", "t2 \<in> bt(A)")

declare bt.intros [simp]

text{*Induction via tactic emulation*}
lemma Br_neq_left [rule_format]: "l \<in> bt(A) ==> \<forall>x r. Br(x, l, r) \<noteq> l"
  --{* @{subgoals[display,indent=0,margin=65]} *}
  apply (induct_tac l)
  --{* @{subgoals[display,indent=0,margin=65]} *}
  apply auto
  done

(*
  apply (Inductive.case_tac l)
  apply (tactic {*exhaust_tac "l" 1*})
*)

text{*The new induction method, which I don't understand*}
lemma Br_neq_left': "l \<in> bt(A) ==> (!!x r. Br(x, l, r) \<noteq> l)"
  --{* @{subgoals[display,indent=0,margin=65]} *}
  apply (induct set: bt)
  --{* @{subgoals[display,indent=0,margin=65]} *}
  apply auto
  done

lemma Br_iff: "Br(a,l,r) = Br(a',l',r') <-> a=a' & l=l' & r=r'"
  -- "Proving a freeness theorem."
  by (blast elim!: bt.free_elims)

inductive_cases Br_in_bt: "Br(a,l,r) \<in> bt(A)"
  -- "An elimination rule, for type-checking."

text {*
@{thm[display] Br_in_bt[no_vars]}
*}

subsection{*Primitive recursion*}

consts  n_nodes :: "i => i"
primrec
  "n_nodes(Lf) = 0"
  "n_nodes(Br(a,l,r)) = succ(n_nodes(l) #+ n_nodes(r))"

lemma n_nodes_type [simp]: "t \<in> bt(A) ==> n_nodes(t) \<in> nat"
  by (induct_tac t, auto)

consts  n_nodes_aux :: "i => i"
primrec
  "n_nodes_aux(Lf) = (\<lambda>k \<in> nat. k)"
  "n_nodes_aux(Br(a,l,r)) =
      (\<lambda>k \<in> nat. n_nodes_aux(r) `  (n_nodes_aux(l) ` succ(k)))"

lemma n_nodes_aux_eq [rule_format]:
     "t \<in> bt(A) ==> \<forall>k \<in> nat. n_nodes_aux(t)`k = n_nodes(t) #+ k"
  by (induct_tac t, simp_all)

definition n_nodes_tail :: "i => i" where
   "n_nodes_tail(t) == n_nodes_aux(t) ` 0"

lemma "t \<in> bt(A) ==> n_nodes_tail(t) = n_nodes(t)"
 by (simp add: n_nodes_tail_def n_nodes_aux_eq)

subsection {*Inductive definitions*}

consts  Fin       :: "i=>i"
inductive
  domains   "Fin(A)" \<subseteq> "Pow(A)"
  intros
    emptyI:  "0 \<in> Fin(A)"
    consI:   "[| a \<in> A;  b \<in> Fin(A) |] ==> cons(a,b) \<in> Fin(A)"
  type_intros  empty_subsetI cons_subsetI PowI
  type_elims   PowD [elim_format]

consts  acc :: "i => i"
inductive
  domains "acc(r)" \<subseteq> "field(r)"
  intros
    vimage:  "[| r-``{a}: Pow(acc(r)); a \<in> field(r) |] ==> a \<in> acc(r)"
  monos      Pow_mono

consts
  llist  :: "i=>i"

codatatype
  "llist(A)" = LNil | LCons ("a \<in> A", "l \<in> llist(A)")

(*Coinductive definition of equality*)
consts
  lleq :: "i=>i"

(*Previously used <*> in the domain and variant pairs as elements.  But
  standard pairs work just as well.  To use variant pairs, must change prefix
  a q/Q to the Sigma, Pair and converse rules.*)
coinductive
  domains "lleq(A)" \<subseteq> "llist(A) * llist(A)"
  intros
    LNil:  "<LNil, LNil> \<in> lleq(A)"
    LCons: "[| a \<in> A; <l,l'> \<in> lleq(A) |]
            ==> <LCons(a,l), LCons(a,l')> \<in> lleq(A)"
  type_intros  llist.intros

subsection{*Powerset example*}

lemma Pow_mono: "A\<subseteq>B  ==>  Pow(A) \<subseteq> Pow(B)"
apply (rule subsetI)
apply (rule PowI)
apply (drule PowD)
apply (erule subset_trans, assumption)
done

lemma "Pow(A Int B) = Pow(A) Int Pow(B)"
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule equalityI)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Int_greatest)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Int_lower1 [THEN Pow_mono])
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Int_lower2 [THEN Pow_mono])
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule subsetI)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (erule IntE)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule PowI)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (drule PowD)+
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Int_greatest)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (assumption+)
done

text{*Trying again from the beginning in order to use @{text blast}*}
lemma "Pow(A Int B) = Pow(A) Int Pow(B)"
by blast

lemma "C\<subseteq>D ==> Union(C) \<subseteq> Union(D)"
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule subsetI)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (erule UnionE)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule UnionI)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (erule subsetD)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
done

text{*A more abstract version of the same proof*}

lemma "C\<subseteq>D ==> Union(C) \<subseteq> Union(D)"
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Union_least)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule Union_upper)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (erule subsetD, assumption)
done

lemma "[| a \<in> A;  f \<in> A->B;  g \<in> C->D;  A \<inter> C = 0 |] ==> (f \<union> g)`a = f`a"
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule apply_equality)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule UnI1)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule apply_Pair)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply (rule fun_disjoint_Un)
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
  --{* @{subgoals[display,indent=0,margin=65]} *}
apply assumption
done

end


(*  Title:      HOL/Algebra/Sylow.thy
    Author:     Florian Kammueller, with new proofs by L C Paulson
*)

theory Sylow
  imports Coset Exponent
begin

text \<open>See also @{cite "Kammueller-Paulson:1999"}.\<close>

text \<open>The combinatorial argument is in theory @{text "Exponent"}.\<close>

lemma le_extend_mult: "\<lbrakk>0 < c; a \<le> b\<rbrakk> \<Longrightarrow> a \<le> b * c"
  for c :: nat
  by (metis divisors_zero dvd_triv_left leI less_le_trans nat_dvd_not_less zero_less_iff_neq_zero)

locale sylow = group +
  fixes p and a and m and calM and RelM
  assumes prime_p: "prime p"
    and order_G: "order G = (p^a) * m"
    and finite_G[iff]: "finite (carrier G)"
  defines "calM \<equiv> {s. s \<subseteq> carrier G \<and> card s = p^a}"
    and "RelM \<equiv> {(N1, N2). N1 \<in> calM \<and> N2 \<in> calM \<and> (\<exists>g \<in> carrier G. N1 = N2 #> g)}"
begin

lemma RelM_refl_on: "refl_on calM RelM"
  by (auto simp: refl_on_def RelM_def calM_def) (blast intro!: coset_mult_one [symmetric])

lemma RelM_sym: "sym RelM"
proof (unfold sym_def RelM_def, clarify)
  fix y g
  assume "y \<in> calM"
    and g: "g \<in> carrier G"
  then have "y = y #> g #> (inv g)"
    by (simp add: coset_mult_assoc calM_def)
  then show "\<exists>g'\<in>carrier G. y = y #> g #> g'"
    by (blast intro: g)
qed

lemma RelM_trans: "trans RelM"
  by (auto simp add: trans_def RelM_def calM_def coset_mult_assoc)

lemma RelM_equiv: "equiv calM RelM"
  unfolding equiv_def by (blast intro: RelM_refl_on RelM_sym RelM_trans)

lemma M_subset_calM_prep: "M' \<in> calM // RelM  \<Longrightarrow> M' \<subseteq> calM"
  unfolding RelM_def by (blast elim!: quotientE)

end

subsection \<open>Main Part of the Proof\<close>

locale sylow_central = sylow +
  fixes H and M1 and M
  assumes M_in_quot: "M \<in> calM // RelM"
    and not_dvd_M: "\<not> (p ^ Suc (multiplicity p m) dvd card M)"
    and M1_in_M: "M1 \<in> M"
  defines "H \<equiv> {g. g \<in> carrier G \<and> M1 #> g = M1}"
begin

lemma M_subset_calM: "M \<subseteq> calM"
  by (rule M_in_quot [THEN M_subset_calM_prep])

lemma card_M1: "card M1 = p^a"
  using M1_in_M M_subset_calM calM_def by blast

lemma exists_x_in_M1: "\<exists>x. x \<in> M1"
  using prime_p [THEN prime_gt_Suc_0_nat] card_M1
  by (metis Suc_lessD card_eq_0_iff empty_subsetI equalityI gr_implies_not0 nat_zero_less_power_iff subsetI)

lemma M1_subset_G [simp]: "M1 \<subseteq> carrier G"
  using M1_in_M M_subset_calM calM_def mem_Collect_eq subsetCE by blast

lemma M1_inj_H: "\<exists>f \<in> H\<rightarrow>M1. inj_on f H"
proof -
  from exists_x_in_M1 obtain m1 where m1M: "m1 \<in> M1"..
  have m1: "m1 \<in> carrier G"
    by (simp add: m1M M1_subset_G [THEN subsetD])
  show ?thesis
  proof
    show "inj_on (\<lambda>z\<in>H. m1 \<otimes> z) H"
      by (simp add: H_def inj_on_def m1)
    show "restrict ((\<otimes>) m1) H \<in> H \<rightarrow> M1"
    proof (rule restrictI)
      fix z
      assume zH: "z \<in> H"
      show "m1 \<otimes> z \<in> M1"
      proof -
        from zH
        have zG: "z \<in> carrier G" and M1zeq: "M1 #> z = M1"
          by (auto simp add: H_def)
        show ?thesis
          by (rule subst [OF M1zeq]) (simp add: m1M zG rcosI)
      qed
    qed
  qed
qed

end

subsection \<open>Discharging the Assumptions of \<open>sylow_central\<close>\<close>

context sylow
begin

lemma EmptyNotInEquivSet: "{} \<notin> calM // RelM"
  by (blast elim!: quotientE dest: RelM_equiv [THEN equiv_class_self])

lemma existsM1inM: "M \<in> calM // RelM \<Longrightarrow> \<exists>M1. M1 \<in> M"
  using RelM_equiv equiv_Eps_in by blast

lemma zero_less_o_G: "0 < order G"
  by (simp add: order_def card_gt_0_iff carrier_not_empty)

lemma zero_less_m: "m > 0"
  using zero_less_o_G by (simp add: order_G)

lemma card_calM: "card calM = (p^a) * m choose p^a"
  by (simp add: calM_def n_subsets order_G [symmetric] order_def)

lemma zero_less_card_calM: "card calM > 0"
  by (simp add: card_calM zero_less_binomial le_extend_mult zero_less_m)

lemma max_p_div_calM: "\<not> (p ^ Suc (multiplicity p m) dvd card calM)"
proof
  assume "p ^ Suc (multiplicity p m) dvd card calM"
  with zero_less_card_calM prime_p
  have "Suc (multiplicity p m) \<le> multiplicity p (card calM)"
    by (intro multiplicity_geI) auto
  then have "multiplicity p m < multiplicity p (card calM)" by simp
  also have "multiplicity p m = multiplicity p (card calM)"
    by (simp add: const_p_fac prime_p zero_less_m card_calM)
  finally show False by simp
qed

lemma finite_calM: "finite calM"
  unfolding calM_def by (rule finite_subset [where B = "Pow (carrier G)"]) auto

lemma lemma_A1: "\<exists>M \<in> calM // RelM. \<not> (p ^ Suc (multiplicity p m) dvd card M)"
  using RelM_equiv equiv_imp_dvd_card finite_calM max_p_div_calM by blast

end

subsubsection \<open>Introduction and Destruct Rules for \<open>H\<close>\<close>

context sylow_central
begin

lemma H_I: "\<lbrakk>g \<in> carrier G; M1 #> g = M1\<rbrakk> \<Longrightarrow> g \<in> H"
  by (simp add: H_def)

lemma H_into_carrier_G: "x \<in> H \<Longrightarrow> x \<in> carrier G"
  by (simp add: H_def)

lemma in_H_imp_eq: "g \<in> H \<Longrightarrow> M1 #> g = M1"
  by (simp add: H_def)

lemma H_m_closed: "\<lbrakk>x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> H"
  by (simp add: H_def coset_mult_assoc [symmetric])

lemma H_not_empty: "H \<noteq> {}"
  by (force simp add: H_def intro: exI [of _ \<one>])

lemma H_is_subgroup: "subgroup H G"
proof (rule subgroupI)
  show "H \<subseteq> carrier G"
    using H_into_carrier_G by blast
  show "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
    by (metis H_I H_into_carrier_G H_m_closed M1_subset_G Units_eq Units_inv_closed Units_inv_inv coset_mult_inv1 in_H_imp_eq)
  show "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
    by (blast intro: H_m_closed)
qed (use H_not_empty in auto)

lemma rcosetGM1g_subset_G: "\<lbrakk>g \<in> carrier G; x \<in> M1 #> g\<rbrakk> \<Longrightarrow> x \<in> carrier G"
  by (blast intro: M1_subset_G [THEN r_coset_subset_G, THEN subsetD])

lemma finite_M1: "finite M1"
  by (rule finite_subset [OF M1_subset_G finite_G])

lemma finite_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> finite (M1 #> g)"
  using rcosetGM1g_subset_G finite_G M1_subset_G cosets_finite rcosetsI by blast

lemma M1_cardeq_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> card (M1 #> g) = card M1"
  by (metis M1_subset_G card_rcosets_equal rcosetsI)

lemma M1_RelM_rcosetGM1g:
  assumes "g \<in> carrier G"
  shows "(M1, M1 #> g) \<in> RelM"
proof -
  have "M1 #> g \<subseteq> carrier G"
    by (simp add: assms r_coset_subset_G)
  moreover have "card (M1 #> g) = p ^ a"
    using assms by (simp add: card_M1 M1_cardeq_rcosetGM1g)
  moreover have "\<exists>h\<in>carrier G. M1 = M1 #> g #> h"
    by (metis assms M1_subset_G coset_mult_assoc coset_mult_one r_inv_ex)
  ultimately show ?thesis
    by (simp add: RelM_def calM_def card_M1)
qed

end

subsection \<open>Equal Cardinalities of \<open>M\<close> and the Set of Cosets\<close>

text \<open>Injections between @{term M} and @{term "rcosets\<^bsub>G\<^esub> H"} show that
 their cardinalities are equal.\<close>

lemma ElemClassEquiv: "\<lbrakk>equiv A r; C \<in> A // r\<rbrakk> \<Longrightarrow> \<forall>x \<in> C. \<forall>y \<in> C. (x, y) \<in> r"
  unfolding equiv_def quotient_def sym_def trans_def by blast

context sylow_central
begin

lemma M_elem_map: "M2 \<in> M \<Longrightarrow> \<exists>g. g \<in> carrier G \<and> M1 #> g = M2"
  using M1_in_M M_in_quot [THEN RelM_equiv [THEN ElemClassEquiv]]
  by (simp add: RelM_def) (blast dest!: bspec)

lemmas M_elem_map_carrier = M_elem_map [THEN someI_ex, THEN conjunct1]

lemmas M_elem_map_eq = M_elem_map [THEN someI_ex, THEN conjunct2]

lemma M_funcset_rcosets_H:
  "(\<lambda>x\<in>M. H #> (SOME g. g \<in> carrier G \<and> M1 #> g = x)) \<in> M \<rightarrow> rcosets H"
  by (metis (lifting) H_is_subgroup M_elem_map_carrier rcosetsI restrictI subgroup.subset)

lemma inj_M_GmodH: "\<exists>f \<in> M \<rightarrow> rcosets H. inj_on f M"
proof
  let ?inv = "\<lambda>x. SOME g. g \<in> carrier G \<and> M1 #> g = x"
  show "inj_on (\<lambda>x\<in>M. H #> ?inv x) M"
  proof (rule inj_onI, simp)
    fix x y
    assume eq: "H #> ?inv x = H #> ?inv y" and xy: "x \<in> M" "y \<in> M"
    have "x = M1 #> ?inv x"
      by (simp add: M_elem_map_eq \<open>x \<in> M\<close>)
    also have "... = M1 #> ?inv y"
    proof (rule coset_mult_inv1 [OF in_H_imp_eq [OF coset_join1]])
      show "H #> ?inv x \<otimes> inv (?inv y) = H"
        by (simp add: H_into_carrier_G M_elem_map_carrier xy coset_mult_inv2 eq subsetI)
    qed (simp_all add: H_is_subgroup M_elem_map_carrier xy)
    also have "... = y"
      using M_elem_map_eq \<open>y \<in> M\<close> by simp
    finally show "x=y" .
  qed
  show "(\<lambda>x\<in>M. H #> ?inv x) \<in> M \<rightarrow> rcosets H"
    by (rule M_funcset_rcosets_H)
qed

end

subsubsection \<open>The Opposite Injection\<close>

context sylow_central
begin

lemma H_elem_map: "H1 \<in> rcosets H \<Longrightarrow> \<exists>g. g \<in> carrier G \<and> H #> g = H1"
  by (auto simp: RCOSETS_def)

lemmas H_elem_map_carrier = H_elem_map [THEN someI_ex, THEN conjunct1]

lemmas H_elem_map_eq = H_elem_map [THEN someI_ex, THEN conjunct2]

lemma rcosets_H_funcset_M:
  "(\<lambda>C \<in> rcosets H. M1 #> (SOME g. g \<in> carrier G \<and> H #> g = C)) \<in> rcosets H \<rightarrow> M"
  using in_quotient_imp_closed [OF RelM_equiv M_in_quot _  M1_RelM_rcosetGM1g]
  by (simp add: M1_in_M H_elem_map_carrier RCOSETS_def)

lemma inj_GmodH_M: "\<exists>g \<in> rcosets H\<rightarrow>M. inj_on g (rcosets H)"
proof
  let ?inv = "\<lambda>x. SOME g. g \<in> carrier G \<and> H #> g = x"
  show "inj_on (\<lambda>C\<in>rcosets H. M1 #> ?inv C) (rcosets H)"
  proof (rule inj_onI, simp)
    fix x y
    assume eq: "M1 #> ?inv x = M1 #> ?inv y" and xy: "x \<in> rcosets H" "y \<in> rcosets H"
    have "x = H #> ?inv x"
      by (simp add: H_elem_map_eq \<open>x \<in> rcosets H\<close>)
    also have "... = H #> ?inv y"
    proof (rule coset_mult_inv1 [OF coset_join2])
      show "?inv x \<otimes> inv (?inv y) \<in> carrier G"
        by (simp add: H_elem_map_carrier \<open>x \<in> rcosets H\<close> \<open>y \<in> rcosets H\<close>)
      then show "(?inv x) \<otimes> inv (?inv y) \<in> H"
        by (simp add: H_I H_elem_map_carrier xy coset_mult_inv2 eq)
      show "H \<subseteq> carrier G"
        by (simp add: H_is_subgroup subgroup.subset)
    qed (simp_all add: H_is_subgroup H_elem_map_carrier xy)
    also have "... = y"
      by (simp add: H_elem_map_eq \<open>y \<in> rcosets H\<close>)
    finally show "x=y" .
  qed
  show "(\<lambda>C\<in>rcosets H. M1 #> ?inv C) \<in> rcosets H \<rightarrow> M"
    using rcosets_H_funcset_M by blast
qed

lemma calM_subset_PowG: "calM \<subseteq> Pow (carrier G)"
  by (auto simp: calM_def)

lemma finite_M: "finite M"
  by (metis M_subset_calM finite_calM rev_finite_subset)

lemma cardMeqIndexH: "card M = card (rcosets H)"
  using inj_M_GmodH inj_GmodH_M
  by (blast intro: card_bij finite_M H_is_subgroup rcosets_subset_PowG [THEN finite_subset])

lemma index_lem: "card M * card H = order G"
  by (simp add: cardMeqIndexH lagrange H_is_subgroup)

lemma card_H_eq: "card H = p^a"
proof (rule antisym)
  show "p^a \<le> card H"
  proof (rule dvd_imp_le)
    show "p ^ a dvd card H"
      apply (rule div_combine [OF prime_imp_prime_elem[OF prime_p] not_dvd_M])
      by (simp add: index_lem multiplicity_dvd order_G power_add)
    show "0 < card H"
      by (blast intro: subgroup.finite_imp_card_positive H_is_subgroup)
  qed
next
  show "card H \<le> p^a"
    using M1_inj_H card_M1 card_inj finite_M1 by fastforce
qed

end

lemma (in sylow) sylow_thm: "\<exists>H. subgroup H G \<and> card H = p^a"
proof -
  obtain M where M: "M \<in> calM // RelM" "\<not> (p ^ Suc (multiplicity p m) dvd card M)"
    using lemma_A1 by blast
  then obtain M1 where "M1 \<in> M"
    by (metis existsM1inM)
  define H where "H \<equiv> {g. g \<in> carrier G \<and> M1 #> g = M1}"
  with M \<open>M1 \<in> M\<close>
  interpret sylow_central G p a m calM RelM H M1 M
    by unfold_locales (auto simp add: H_def calM_def RelM_def)
  show ?thesis
    using H_is_subgroup card_H_eq by blast
qed

text \<open>Needed because the locale's automatic definition refers to
  @{term "semigroup G"} and @{term "group_axioms G"} rather than
  simply to @{term "group G"}.\<close>
lemma sylow_eq: "sylow G p a m \<longleftrightarrow> group G \<and> sylow_axioms G p a m"
  by (simp add: sylow_def group_def)

subsection \<open>Sylow's Theorem\<close>

theorem sylow_thm:
  "\<lbrakk>prime p; group G; order G = (p^a) * m; finite (carrier G)\<rbrakk>
    \<Longrightarrow> \<exists>H. subgroup H G \<and> card H = p^a"
  by (rule sylow.sylow_thm [of G p a m]) (simp add: sylow_eq sylow_axioms_def)

end