(*
    Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
*)

section \<open>Some useful lemmas in analysis\<close>

theory Missing_Analysis
  imports "HOL-Complex_Analysis.Complex_Analysis"
begin

subsection \<open>More about paths\<close>

lemma pathfinish_offset[simp]:
  "pathfinish (\<lambda>t. g t - z) = pathfinish g - z"
  unfolding pathfinish_def by simp

lemma pathstart_offset[simp]:
  "pathstart (\<lambda>t. g t - z) = pathstart g - z"
  unfolding pathstart_def by simp

lemma pathimage_offset[simp]:
  fixes g :: "_ \<Rightarrow> 'b::topological_group_add"
  shows "p \<in> path_image (\<lambda>t. g t - z) \<longleftrightarrow> p+z \<in> path_image g "
unfolding path_image_def by (auto simp:algebra_simps)

lemma path_offset[simp]:
 fixes g :: "_ \<Rightarrow> 'b::topological_group_add"
 shows "path (\<lambda>t. g t - z) \<longleftrightarrow> path g"
unfolding path_def
proof
  assume "continuous_on {0..1} (\<lambda>t. g t - z)"
  hence "continuous_on {0..1} (\<lambda>t. (g t - z) + z)"
    apply (rule continuous_intros)
    by (intro continuous_intros)
  then show "continuous_on {0..1} g" by auto
qed (auto intro:continuous_intros)

lemma not_on_circlepathI:
  assumes "cmod (z-z0) \<noteq> \<bar>r\<bar>"
  shows "z \<notin> path_image (part_circlepath z0 r st tt)"
proof (rule ccontr)
  assume "\<not> z \<notin> path_image (part_circlepath z0 r st tt)"
  then have "z\<in>path_image (part_circlepath z0 r st tt)" by simp
  then obtain t where "t\<in>{0..1}" and *:"z = z0 + r * exp (\<i> * (linepath st tt t))"
    unfolding path_image_def image_def part_circlepath_def by blast
  define \<theta> where "\<theta> = linepath st tt t"
  then have "z-z0 = r * exp (\<i> * \<theta>)" using * by auto
  then have "cmod (z-z0) = cmod (r * exp (\<i> * \<theta>))" by auto
  also have "\<dots> = \<bar>r\<bar> * cmod (exp (\<i> * \<theta>))" by (simp add: norm_mult)
  also have "\<dots> = \<bar>r\<bar>" by auto
  finally have "cmod (z-z0) = \<bar>r\<bar>" .
  then show False using assms by auto
qed

lemma circlepath_inj_on:
  assumes "r>0"
  shows "inj_on (circlepath z r) {0..<1}"
proof (rule inj_onI)
  fix x y assume asm: "x \<in> {0..<1}" "y \<in> {0..<1}" "circlepath z r x = circlepath z r y"
  define c where "c=2 * pi * \<i>"
  have "c\<noteq>0" unfolding c_def by auto
  from asm(3) have "exp (c * x) =exp (c * y)"
    unfolding circlepath c_def using \<open>r>0\<close> by auto
  then obtain n where "c * x =c * (y + of_int n)"
    by (auto simp add:exp_eq c_def algebra_simps)
  then have "x=y+n" using \<open>c\<noteq>0\<close>
    by (meson mult_cancel_left of_real_eq_iff)
  then show "x=y" using asm(1,2) by auto
qed

subsection \<open>More lemmas related to @{term winding_number}\<close>

lemma winding_number_comp:
  assumes "open s" "f holomorphic_on s" "path_image \<gamma> \<subseteq> s"
    "valid_path \<gamma>" "z \<notin> path_image (f \<circ> \<gamma>)"
  shows "winding_number (f \<circ> \<gamma>) z = 1/(2*pi*\<i>)* contour_integral \<gamma> (\<lambda>w. deriv f w / (f w - z))"
proof -
  obtain spikes where "finite spikes" and \<gamma>_diff: "\<gamma> C1_differentiable_on {0..1} - spikes"
    using \<open>valid_path \<gamma>\<close> unfolding valid_path_def piecewise_C1_differentiable_on_def by auto
  have "valid_path (f \<circ> \<gamma>)"
    using valid_path_compose_holomorphic assms by blast
  moreover have "contour_integral (f \<circ> \<gamma>) (\<lambda>w. 1 / (w - z))
      = contour_integral \<gamma> (\<lambda>w. deriv f w / (f w - z))"
    unfolding contour_integral_integral
  proof (rule integral_spike[rule_format,OF negligible_finite[OF \<open>finite spikes\<close>]])
    fix t::real assume t:"t \<in> {0..1} - spikes"
    then have "\<gamma> differentiable at t"
      using \<gamma>_diff unfolding C1_differentiable_on_eq by auto
    moreover have "f field_differentiable at (\<gamma> t)"
    proof -
      have "\<gamma> t \<in> s" using \<open>path_image \<gamma> \<subseteq> s\<close> t unfolding path_image_def by auto
      thus ?thesis
        using \<open>open s\<close> \<open>f holomorphic_on s\<close>  holomorphic_on_imp_differentiable_at by blast
    qed
    ultimately show " deriv f (\<gamma> t) / (f (\<gamma> t) - z) * vector_derivative \<gamma> (at t) =
         1 / ((f \<circ> \<gamma>) t - z) * vector_derivative (f \<circ> \<gamma>) (at t)"
      apply (subst vector_derivative_chain_at_general)
      by (simp_all add:field_simps)
  qed
  moreover note \<open>z \<notin> path_image (f \<circ> \<gamma>)\<close>
  ultimately show ?thesis
    apply (subst winding_number_valid_path)
    by simp_all
qed

lemma winding_number_uminus_comp:
  assumes "valid_path \<gamma>" "- z \<notin> path_image \<gamma>"
  shows "winding_number (uminus \<circ> \<gamma>) z = winding_number \<gamma> (-z)"
proof -
  define c where "c= 2 * pi * \<i>"
  have "winding_number (uminus \<circ> \<gamma>) z = 1/c * contour_integral \<gamma> (\<lambda>w. deriv uminus w / (-w-z)) "
  proof (rule winding_number_comp[of UNIV, folded c_def])
    show "open UNIV" "uminus holomorphic_on UNIV" "path_image \<gamma> \<subseteq> UNIV" "valid_path \<gamma>"
      using \<open>valid_path \<gamma>\<close> by (auto intro:holomorphic_intros)
    show "z \<notin> path_image (uminus \<circ> \<gamma>)"
      unfolding path_image_compose using \<open>- z \<notin> path_image \<gamma>\<close> by auto
  qed
  also have "\<dots> = 1/c * contour_integral \<gamma> (\<lambda>w. 1 / (w- (-z)))"
    by (auto intro!:contour_integral_eq simp add:field_simps minus_divide_right)
  also have "\<dots> = winding_number \<gamma> (-z)"
    using winding_number_valid_path[OF \<open>valid_path \<gamma>\<close> \<open>- z \<notin> path_image \<gamma>\<close>,folded c_def]
    by simp
  finally show ?thesis by auto
qed

lemma winding_number_comp_linear:
  assumes "c\<noteq>0" "valid_path \<gamma>" and not_image: "(z-b)/c \<notin> path_image \<gamma>"
  shows "winding_number ((\<lambda>x. c*x+b) \<circ> \<gamma>) z = winding_number \<gamma> ((z-b)/c)" (is "?L = ?R")
proof -
  define cc where "cc=1 / (complex_of_real (2 * pi) * \<i>)"
  define zz where "zz=(z-b)/c"
  have "?L = cc * contour_integral \<gamma> (\<lambda>w. deriv (\<lambda>x. c * x + b) w / (c * w + b - z))"
    apply (subst winding_number_comp[of UNIV,simplified])
    subgoal by (auto intro:holomorphic_intros)
    subgoal using \<open>valid_path \<gamma>\<close> .
    subgoal using not_image \<open>c\<noteq>0\<close> unfolding path_image_compose by auto
    subgoal unfolding cc_def by auto
    done
  also have "\<dots> = cc * contour_integral \<gamma> (\<lambda>w.1 / (w - zz))"
  proof -
    have "deriv (\<lambda>x. c * x + b) = (\<lambda>x. c)"
      by (auto intro:derivative_intros)
    then show ?thesis
      unfolding zz_def cc_def using \<open>c\<noteq>0\<close>
      by (auto simp:field_simps)
  qed
  also have "\<dots> = winding_number \<gamma> zz"
    using winding_number_valid_path[OF \<open>valid_path \<gamma>\<close> not_image,folded zz_def cc_def]
    by simp
  finally show "winding_number ((\<lambda>x. c * x + b) \<circ> \<gamma>) z = winding_number \<gamma> zz" .
qed

end


theory ex3_08 imports Main "~~/src/HOL/IMP/AExp" "~~/src/HOL/IMP/BExp" begin

datatype ifexp = Bc2 bool | If ifexp ifexp ifexp | Less2 aexp aexp

fun ifval :: "ifexp \<Rightarrow> state \<Rightarrow> bool" where
"ifval (Bc2 b) _ = b" |
"ifval (If b e1 e2) s = (if (ifval b s) then ifval e1 s else ifval e2 s)" |
"ifval (Less2 a1 a2) s = (aval a1 s < aval a2 s)"

fun b2ifexp :: "bexp \<Rightarrow> ifexp" where
"b2ifexp (Bc b) = Bc2 b" |
"b2ifexp (Not b) = If (b2ifexp b) (Bc2 False) (Bc2 True)" |
"b2ifexp (And b1 b2) = If (b2ifexp b1) (If (b2ifexp b2) (Bc2 True) (Bc2 False)) (Bc2 False)" |
"b2ifexp (Less a1 a2) = Less2 a1 a2"

fun if2bexp :: "ifexp \<Rightarrow> bexp" where
"if2bexp (Bc2 b) = Bc b" |
"if2bexp (If b e1 e2) = (Not (And (Not (And (if2bexp b) (if2bexp e1))) (Not (And (Not (if2bexp b)) (if2bexp e2)))))" |
"if2bexp (Less2 a1 a2) = Less a1 a2"

theorem "bval e s = ifval (b2ifexp e) s"
apply(induction e)
apply auto
done

theorem "ifval e s = bval (if2bexp e) s"
apply(induction e)
apply auto
done

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_78
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "bool => bool => bool" where
  "x True z = z"
| "x False z = False"

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

fun insort :: "Nat => Nat list => Nat list" where
  "insort y (nil2) = cons2 y (nil2)"
| "insort y (cons2 z2 xs) =
     (if t2 y z2 then cons2 y (cons2 z2 xs) else cons2 z2 (insort y xs))"

fun sort :: "Nat list => Nat list" where
  "sort (nil2) = nil2"
| "sort (cons2 z xs) = insort z (sort xs)"

fun sorted :: "Nat list => bool" where
  "sorted (nil2) = True"
| "sorted (cons2 z (nil2)) = True"
| "sorted (cons2 z (cons2 y2 ys)) =
     x (t2 z y2) (sorted (cons2 y2 ys))"

theorem property0 :
  "sorted (sort xs)"
  oops

end


(*
  File: Abs.thy
  Author: Bohua Zhan

  Basic results about absolute value.
*)

theory Abs
  imports Field
begin

section \<open>Absolute value\<close>

definition abs :: "i \<Rightarrow> i \<Rightarrow> i"  ("\<bar>_\<bar>\<^sub>_" [0,91] 90) where [rewrite]:
  "\<bar>x\<bar>\<^sub>R = (if x \<ge>\<^sub>R \<zero>\<^sub>R then x else -\<^sub>R x)"
setup {* register_wellform_data ("\<bar>x\<bar>\<^sub>R", ["x \<in>. R"]) *}

setup {* add_gen_prfstep ("abs_case",
  [WithTerm @{term_pat "\<bar>?x\<bar>\<^sub>?R"}, CreateCase @{term_pat "?x \<ge>\<^sub>?R \<zero>\<^sub>?R"}]) *}

lemma abs_nonneg [rewrite]: "x \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> \<bar>x\<bar>\<^sub>R = x" by auto2
lemma abs_neg [rewrite]: "is_ord_ring(R) \<Longrightarrow> x \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> \<bar>x\<bar>\<^sub>R = -\<^sub>R x" by auto2
lemma abs_mem [typing]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<in>. R" by auto2
setup {* del_prfstep_thm @{thm abs_def} *}

lemma abs_zero [rewrite]: "is_ord_ring(R) \<Longrightarrow> \<bar>\<zero>\<^sub>R\<bar>\<^sub>R = \<zero>\<^sub>R" by auto2
lemma abs_minus [rewrite]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>-\<^sub>R x\<bar>\<^sub>R = \<bar>x\<bar>\<^sub>R" by auto2
lemma abs_not_less_zero [resolve]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<ge>\<^sub>R \<zero>\<^sub>R" by auto2
lemma abs_le_zero [forward]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x = \<zero>\<^sub>R" by auto2
lemma abs_positive [rewrite]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R >\<^sub>R \<zero>\<^sub>R \<longleftrightarrow> x \<noteq> \<zero>\<^sub>R" by auto2
lemma abs_mult [rewrite]: "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x *\<^sub>R y\<bar>\<^sub>R = \<bar>x\<bar>\<^sub>R *\<^sub>R \<bar>y\<bar>\<^sub>R" by auto2
lemma abs_inverse [rewrite]: "is_ord_field(R) \<Longrightarrow> x \<in> units(R) \<Longrightarrow> \<bar>inv(R,x)\<bar>\<^sub>R = inv(R,\<bar>x\<bar>\<^sub>R)" by auto2
lemma abs_div [rewrite]: "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in> units(R) \<Longrightarrow> \<bar>x /\<^sub>R y\<bar>\<^sub>R = \<bar>x\<bar>\<^sub>R /\<^sub>R \<bar>y\<bar>\<^sub>R"
  @proof @have "x /\<^sub>R y = x *\<^sub>R inv(R,y)" @have "\<bar>x\<bar>\<^sub>R /\<^sub>R \<bar>y\<bar>\<^sub>R = \<bar>x\<bar>\<^sub>R *\<^sub>R inv(R,\<bar>y\<bar>\<^sub>R)" @qed

lemma abs_ge_cases [forward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<ge>\<^sub>R r \<Longrightarrow> x >\<^sub>R -\<^sub>R r \<Longrightarrow> x \<ge>\<^sub>R r"
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<ge>\<^sub>R r \<Longrightarrow> x <\<^sub>R r \<Longrightarrow> x \<le>\<^sub>R -\<^sub>R r" by auto2+

lemma abs_gt_cases [forward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R >\<^sub>R r \<Longrightarrow> x \<ge>\<^sub>R -\<^sub>R r \<Longrightarrow> x >\<^sub>R r"
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R >\<^sub>R r \<Longrightarrow> x \<le>\<^sub>R r \<Longrightarrow> x <\<^sub>R -\<^sub>R r" by auto2+

lemma abs_le [resolve]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<le>\<^sub>R r \<Longrightarrow> x \<le>\<^sub>R r"
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<le>\<^sub>R r \<Longrightarrow> x \<ge>\<^sub>R -\<^sub>R r" by auto2+

lemma abs_less [resolve]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R r \<Longrightarrow> x <\<^sub>R r"
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R r \<Longrightarrow> x >\<^sub>R -\<^sub>R r" by auto2+

lemma abs_diff_nonneg [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> a \<ge>\<^sub>R b \<Longrightarrow> \<bar>a -\<^sub>R b\<bar>\<^sub>R = a -\<^sub>R b" by auto2

setup {* del_prfstep "abs_case" *}

lemma abs_diff_sym [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x -\<^sub>R y\<bar>\<^sub>R = \<bar>y -\<^sub>R x\<bar>\<^sub>R"
@proof @have "y -\<^sub>R x = -\<^sub>R (x -\<^sub>R y)" @qed

lemma abs_sum [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<le>\<^sub>R s \<Longrightarrow> \<bar>y\<bar>\<^sub>R \<le>\<^sub>R t \<Longrightarrow> \<bar>x +\<^sub>R y\<bar>\<^sub>R \<le>\<^sub>R s +\<^sub>R t"
@proof
  @have "x +\<^sub>R y \<le>\<^sub>R s +\<^sub>R t" @with @have "x \<le>\<^sub>R s" @end
  @have "x +\<^sub>R y \<ge>\<^sub>R -\<^sub>R s +\<^sub>R -\<^sub>R t" @with @have "x \<ge>\<^sub>R -\<^sub>R s" @end
@qed

lemma abs_sum_strict1 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R s \<Longrightarrow> \<bar>y\<bar>\<^sub>R \<le>\<^sub>R t \<Longrightarrow> \<bar>x +\<^sub>R y\<bar>\<^sub>R <\<^sub>R s +\<^sub>R t"
@proof
  @have "x +\<^sub>R y <\<^sub>R s +\<^sub>R t" @with @have "x <\<^sub>R s" @end
  @have "x +\<^sub>R y >\<^sub>R -\<^sub>R s +\<^sub>R -\<^sub>R t" @with @have "x >\<^sub>R -\<^sub>R s" @end
@qed

lemma abs_sum_strict2 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R \<le>\<^sub>R s \<Longrightarrow> \<bar>y\<bar>\<^sub>R <\<^sub>R t \<Longrightarrow> \<bar>x +\<^sub>R y\<bar>\<^sub>R <\<^sub>R s +\<^sub>R t"
@proof
  @have "x +\<^sub>R y <\<^sub>R s +\<^sub>R t" @with @have "x \<le>\<^sub>R s" @end
  @have "x +\<^sub>R y >\<^sub>R -\<^sub>R s +\<^sub>R -\<^sub>R t" @with @have "x \<ge>\<^sub>R -\<^sub>R s" @end
@qed

lemma abs_sum_half1 [backward1, backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R r /\<^sub>R 2\<^sub>R \<Longrightarrow> \<bar>y\<bar>\<^sub>R <\<^sub>R r /\<^sub>R 2\<^sub>R \<Longrightarrow> \<bar>x +\<^sub>R y\<bar>\<^sub>R <\<^sub>R r"
@proof @have "r = r /\<^sub>R 2\<^sub>R +\<^sub>R r /\<^sub>R 2\<^sub>R" @qed

lemma abs_cancel_diff [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow>
   \<bar>x -\<^sub>R y\<bar>\<^sub>R \<le>\<^sub>R s \<Longrightarrow> \<bar>y -\<^sub>R z\<bar>\<^sub>R \<le>\<^sub>R t \<Longrightarrow> \<bar>x -\<^sub>R z\<bar>\<^sub>R \<le>\<^sub>R s +\<^sub>R t"
@proof @have "x -\<^sub>R z = (x -\<^sub>R y) +\<^sub>R (y -\<^sub>R z)" @qed

lemma abs_cancel_diff_strict1 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow>
   \<bar>x -\<^sub>R y\<bar>\<^sub>R <\<^sub>R s \<Longrightarrow> \<bar>y -\<^sub>R z\<bar>\<^sub>R \<le>\<^sub>R t \<Longrightarrow> \<bar>x -\<^sub>R z\<bar>\<^sub>R <\<^sub>R s +\<^sub>R t"
@proof @have "x -\<^sub>R z = (x -\<^sub>R y) +\<^sub>R (y -\<^sub>R z)" @qed

lemma abs_cancel_diff_strict2 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow>
   \<bar>x -\<^sub>R y\<bar>\<^sub>R <\<^sub>R s \<Longrightarrow> \<bar>y -\<^sub>R z\<bar>\<^sub>R <\<^sub>R t \<Longrightarrow> \<bar>x -\<^sub>R z\<bar>\<^sub>R <\<^sub>R s +\<^sub>R t" by auto2

lemma abs_cancel_diff_half1 [backward1, backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow>
   \<bar>x -\<^sub>R y\<bar>\<^sub>R <\<^sub>R r /\<^sub>R 2\<^sub>R \<Longrightarrow> \<bar>y -\<^sub>R z\<bar>\<^sub>R <\<^sub>R r /\<^sub>R 2\<^sub>R \<Longrightarrow> \<bar>x -\<^sub>R z\<bar>\<^sub>R <\<^sub>R r"
@proof @have "r = r /\<^sub>R 2\<^sub>R +\<^sub>R r /\<^sub>R 2\<^sub>R" @qed

lemma abs_prod_upper_bound [backward1, backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R s \<Longrightarrow> \<bar>y\<bar>\<^sub>R <\<^sub>R t \<Longrightarrow> \<bar>x *\<^sub>R y\<bar>\<^sub>R <\<^sub>R s *\<^sub>R t"
@proof @contradiction @have "\<bar>x *\<^sub>R y\<bar>\<^sub>R \<noteq> s *\<^sub>R t" @qed

lemma abs_prod_upper_bound2 [backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> s \<in>. R \<Longrightarrow> t \<in> units(R) \<Longrightarrow>
   \<bar>x\<bar>\<^sub>R <\<^sub>R s /\<^sub>R t \<Longrightarrow> \<bar>y\<bar>\<^sub>R <\<^sub>R t \<Longrightarrow> \<bar>x *\<^sub>R y\<bar>\<^sub>R <\<^sub>R s"
@proof @have "s = (s /\<^sub>R t) *\<^sub>R t" @qed

lemma abs_prod_upper_bound2' [backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> s \<in>. R \<Longrightarrow> t \<in> units(R) \<Longrightarrow>
   \<bar>x\<bar>\<^sub>R <\<^sub>R s /\<^sub>R t \<Longrightarrow> \<bar>y\<bar>\<^sub>R <\<^sub>R t \<Longrightarrow> \<bar>y *\<^sub>R x\<bar>\<^sub>R <\<^sub>R s"
@proof @have "x *\<^sub>R y = y *\<^sub>R x" @qed

lemma abs_prod_lower_bound [backward1]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> s >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> t >\<^sub>R \<zero>\<^sub>R \<Longrightarrow>
   \<bar>x\<bar>\<^sub>R >\<^sub>R s \<Longrightarrow> \<bar>y\<bar>\<^sub>R >\<^sub>R t \<Longrightarrow> \<bar>x *\<^sub>R y\<bar>\<^sub>R >\<^sub>R s *\<^sub>R t" by auto2

lemma abs_div_upper_bound [backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> \<bar>x\<bar>\<^sub>R <\<^sub>R a \<Longrightarrow> \<bar>y\<bar>\<^sub>R >\<^sub>R b \<and> b >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> \<bar>x /\<^sub>R y\<bar>\<^sub>R <\<^sub>R a /\<^sub>R b"
@proof @have "\<bar>x\<bar>\<^sub>R *\<^sub>R inv(R,\<bar>y\<bar>\<^sub>R) <\<^sub>R a *\<^sub>R inv(R,b)" @qed

lemma abs_div_upper_bound2 [backward2]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in> units(R) \<Longrightarrow> s \<in>. R \<Longrightarrow>
   \<bar>x\<bar>\<^sub>R <\<^sub>R s *\<^sub>R t \<Longrightarrow> \<bar>y\<bar>\<^sub>R >\<^sub>R t \<and> t >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> \<bar>x /\<^sub>R y\<bar>\<^sub>R <\<^sub>R s"
@proof @have "s = s *\<^sub>R t /\<^sub>R t" @qed

(* Bounds on Abs in terms of components. *)
lemma abs_sum_bound [resolve]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> \<bar>a +\<^sub>R b\<bar>\<^sub>R \<le>\<^sub>R \<bar>a\<bar>\<^sub>R +\<^sub>R \<bar>b\<bar>\<^sub>R"
@proof @have "\<bar>a\<bar>\<^sub>R \<le>\<^sub>R \<bar>a\<bar>\<^sub>R" @qed

lemma abs_diff_to_abs_bound [resolve]:
  "is_ord_field(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> c \<in>. R \<Longrightarrow> \<bar>a -\<^sub>R b\<bar>\<^sub>R <\<^sub>R c \<Longrightarrow> \<bar>a\<bar>\<^sub>R <\<^sub>R \<bar>b\<bar>\<^sub>R +\<^sub>R c"
@proof @have "\<bar>b +\<^sub>R (a -\<^sub>R b)\<bar>\<^sub>R \<le>\<^sub>R \<bar>b\<bar>\<^sub>R +\<^sub>R \<bar>a -\<^sub>R b\<bar>\<^sub>R" @qed

(* Bounds on differences to averages *)
setup {* add_rewrite_rule @{thm avg_def} *}
lemma avg_diff [rewrite]:
  "is_ord_field(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> \<bar>a -\<^sub>R avg(R,a,b)\<bar>\<^sub>R = \<bar>a -\<^sub>R b\<bar>\<^sub>R /\<^sub>R 2\<^sub>R"
@proof
  @case "a \<le>\<^sub>R b" @with
    @have "a \<le>\<^sub>R avg(R,a,b)" @have "(a +\<^sub>R b) /\<^sub>R 2\<^sub>R -\<^sub>R a = (b -\<^sub>R a) /\<^sub>R 2\<^sub>R" @end
  @case "a \<ge>\<^sub>R b" @with
    @have "a \<ge>\<^sub>R avg(R,a,b)" @have "a -\<^sub>R (a +\<^sub>R b) /\<^sub>R 2\<^sub>R = (a -\<^sub>R b) /\<^sub>R 2\<^sub>R" @end
@qed

lemma avg_diff2 [rewrite]:
  "is_ord_field(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> \<bar>b -\<^sub>R avg(R,a,b)\<bar>\<^sub>R = \<bar>a -\<^sub>R b\<bar>\<^sub>R /\<^sub>R 2\<^sub>R"
@proof @have "avg(R,a,b) = avg(R,b,a)" @qed
setup {* del_prfstep_thm @{thm avg_def} *}

(* Two redundancies *)
setup {* add_gen_prfstep ("shadow_abs_upper_triv",
  [WithProperty @{term_pat "is_ord_ring(?R)"},
   WithFact @{term_pat "\<bar>?x -\<^sub>?R ?x\<bar>\<^sub>R <\<^sub>?R ?r"},
   WithFact @{term_pat "?r >\<^sub>?R \<zero>\<^sub>?R"}, ShadowFirst]) *}
setup {* add_gen_prfstep ("shadow_abs_upper_sym",
  [WithProperty @{term_pat "is_ord_ring(?R)"},
   WithFact @{term_pat "\<bar>?x -\<^sub>?R ?y\<bar>\<^sub>?R <\<^sub>?R ?r"},
   WithFact @{term_pat "\<bar>?y -\<^sub>?R ?x\<bar>\<^sub>?R <\<^sub>?R ?r"}, ShadowSecond]) *}

end


theory AExp
  imports Main
begin

(* syntax  *)
type_synonym vname = string
datatype aexp = N int | V vname | Plus aexp aexp | Times aexp aexp

(* semantics  *)
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
"aval (N n) s = n" |
"aval (V x) s = s x" |
"aval (Plus a1 a2) s = aval a1 s + aval a2 s" |
"aval (Times a1 a2) s = (aval a1 s) * (aval a2 s)"

(* local optimizations *)
fun plus :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"plus (N i1) (N i2) = N(i1 + i2)" |
"plus (N i) a = (if i=0 then a else Plus (N i) a)" |
"plus a (N i) = (if i=0 then a else Plus a (N i))" |
"plus a1 a2 = Plus a1 a2"

lemma aval_plus[simp]: "aval (plus a1 a2) s  = aval a1 s + aval a2 s"
  apply(induction a1 a2 rule: plus.induct)
  apply(auto)
  done

fun times :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"times (N i1) (N i2) = N(i1 * i2)" |
"times (N i) a = (if i=0 then (N 0) else (if i=1 then a else Times (N i) a))" |
"times a (N i) = (if i=0 then (N 0) else (if i=1 then a else Times a (N i)))" |
"times a1 a2 = Times a1 a2"

lemma aval_times[simp]: "aval (times a1 a2) s = aval a1 s * aval a2 s"
  apply(induction a1 a2 rule: times.induct)
  apply(auto)
  done

(* term traversing *)
fun asimp :: "aexp \<Rightarrow> aexp" where
"asimp (N n) = N n" |
"asimp (V x) = V x" |
"asimp (Plus a1 a2) = plus (asimp a1) (asimp a2)" |
"asimp (Times a1 a2) = times (asimp a1) (asimp a2)"

lemma asimp_correctness[simp]: "aval (asimp a) s = aval a s"
  apply(induction a)
  apply(auto)
  done

end


theory Isar_Demo
imports Complex_Main
begin

section "An introductory example"

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume 0: "surj f"
  from 0 have 1: "\<forall>A. \<exists>a. A = f a" by(simp add: surj_def)
  from 1 have 2: "\<exists>a. {x. x \<notin> f x} = f a" by blast
  from 2 show "False" by blast
qed

text \<open>A bit shorter:\<close>

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume 0: "surj f"
  from 0 have 1: "\<exists>a. {x. x \<notin> f x} = f a" by(auto simp: surj_def)
  from 1 show "False" by blast
qed

subsection \<open>"this", "then", "hence" and "thus\<close>

text \<open>Avoid labels, use "this"\<close>

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  from this have "\<exists>a. {x. x \<notin> f x} = f a" by(auto simp: surj_def)
  from this show "False" by blast
qed

text \<open>"then" = "from this"\<close>

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  then have "\<exists>a. {x. x \<notin> f x} = f a" by(auto simp: surj_def)
  then show "False" by blast
qed

text \<open>"hence" = "then have", "thus" = "then show"\<close>

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists>a. {x. x \<notin> f x} = f a" by(auto simp: surj_def)
  thus "False" by blast
qed

subsection \<open>Structured statements: "fixes", "assumes", "shows"\<close>

lemma
  fixes f :: "'a \<Rightarrow> 'a set"
  assumes s: "surj f"
  shows "False"
proof -  (* no automatic proof step! *)
  have "\<exists> a. {x. x \<notin> f x} = f a" using s
    by(auto simp: surj_def)
  thus "False" by blast
qed

section "Proof patterns"

lemma "P \<longleftrightarrow> Q"
proof
  assume "P"
  show "Q" sorry
next
  assume "Q"
  show "P" sorry
qed

lemma "A = (B::'a set)"
proof
  show "A \<subseteq> B" sorry
next
  show "B \<subseteq> A" sorry
qed

lemma "A \<subseteq> B"
proof
  fix a
  assume "a \<in> A"
  show "a \<in> B" sorry
qed

text "Contradiction"

lemma P
proof (rule ccontr)
  assume "\<not>P"
  show "False" sorry
qed

text "Case distinction"

lemma "R"
proof cases
  assume "P"
  show "R" sorry
next
  assume "\<not> P"
  show "R" sorry
qed

lemma "R"
proof -
  have "P \<or> Q" sorry
  then show "R"
  proof
    assume "P"
    show "R" sorry
  next
    assume "Q"
    show "R" sorry
  qed
qed

text \<open>"obtain" example\<close>

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists>a. {x. x \<notin> f x} = f a" by(auto simp: surj_def)
  then obtain a where "{x. x \<notin> f x} = f a" by blast
  hence "a \<notin> f a \<longleftrightarrow> a \<in> f a" by blast
  thus "False" by blast
qed

text \<open>Interactive exercise:\<close>

lemma assumes "\<exists>x. \<forall>y. P x y" shows "\<forall>y. \<exists>x. P x y"
sorry

subsection \<open>(In)Equation Chains\<close>

lemma "(0::real) \<le> x^2 + y^2 - 2*x*y"
proof -
  have "0 \<le> (x - y)^2" by simp
  also have "\<dots> = x^2 + y^2 - 2*x*y"
    by(simp add: numeral_eq_Suc algebra_simps)
  finally show "0 \<le> x^2 + y^2 - 2*x*y" .
qed

text \<open>Interactive exercise:\<close>

lemma
  fixes x y :: real
  assumes "x \<ge> y" "y > 0"
  shows "(x - y) ^ 2 \<le> x^2 - y^2"
proof -
  have "(x - y) ^ 2 = x^2 + y^2 - 2*x*y"
    by(simp add: numeral_eq_Suc algebra_simps)
  show "(x - y) ^ 2 \<le> x^2 - y^2" sorry
qed

section "Streamlining proofs"

subsection "Pattern matching and ?-variables"

text \<open>Show \<open>\<exists>\<close>\<close>

lemma "\<exists> xs. length xs = 0" (is "\<exists> xs. ?P xs")
proof
  show "?P([])" by simp
qed

text \<open>Multiple EX easier with forward proof:\<close>

lemma "\<exists> x y :: int. x < z & z < y" (is "\<exists> x y. ?P x y")
proof -
  have "?P (z - 1) (z + 1)" by arith
  thus ?thesis by blast
qed

subsection "Quoting facts"

lemma assumes "x < (0::int)" shows "x*x > 0"
proof -
  from `x<0` show ?thesis by(metis mult_neg_neg)
qed

subsection "Example: Top Down Proof Development"

lemma "\<exists>ys zs. xs = ys @ zs \<and>
          (length ys = length zs \<or> length ys = length zs + 1)"
sorry

section "Solutions to interactive exercises"

lemma assumes "\<exists>x. \<forall>y. P x y" shows "\<forall>y. \<exists>x. P x y"
proof
  fix b
  from assms obtain a where 0: "\<forall>y. P a y" by blast
  show "\<exists>x. P x b"
  proof
    show "P a b" using 0 by blast
  qed
qed

lemma fixes x y :: real assumes "x \<ge> y" "y > 0"
shows "(x - y) ^ 2 \<le> x^2 - y^2"
proof -
  have "(x - y) ^ 2 = x^2 + y^2 - 2*x*y"
    by(simp add: numeral_eq_Suc algebra_simps)
  also have "\<dots> \<le> x^2 + y^2 - 2*y*y"
    using assms by(simp)
  also have "\<dots> = x^2 - y^2"
    by(simp add: numeral_eq_Suc)
  finally show ?thesis .
qed

subsection "Example: Top Down Proof Development"

text \<open>The key idea: case distinction on length:\<close>

lemma "\<exists>ys zs. xs = ys @ zs \<and> (length ys = length zs \<or> length ys = length zs + 1)"
proof cases
  assume "EX n. length xs = n+n"
  show ?thesis sorry
next
  assume "\<not> (EX n. length xs = n+n)"
  show ?thesis sorry
qed

text \<open>A proof skeleton:\<close>

lemma "\<exists>ys zs. xs = ys @ zs \<and> (length ys = length zs \<or> length ys = length zs + 1)"
proof cases
  assume "\<exists>n. length xs = n+n"
  then obtain n where "length xs = n+n" by blast
  let ?ys = "take n xs"
  let ?zs = "take n (drop n xs)"
  have "xs = ?ys @ ?zs \<and> length ?ys = length ?zs" sorry
  thus ?thesis by blast
next
  assume "\<not> (\<exists>n. length xs = n+n)"
  then obtain n where "length xs = Suc(n+n)" sorry
  let ?ys = "take (Suc n) xs"
  let ?zs = "take n (drop (Suc n) xs)"
  have "xs = ?ys @ ?zs \<and> length ?ys = length ?zs + 1" sorry
  then show ?thesis by blast
qed

text "The complete proof:"

lemma "\<exists>ys zs. xs = ys @ zs \<and> (length ys = length zs \<or> length ys = length zs + 1)"
proof cases
  assume "\<exists>n. length xs = n+n"
  then obtain n where "length xs = n+n" by blast
  let ?ys = "take n xs"
  let ?zs = "take n (drop n xs)"
  have "xs = ?ys @ ?zs \<and> length ?ys = length ?zs"
    by (simp add: `length xs = n + n`)
  thus ?thesis by blast
next
  assume "\<not> (\<exists>n. length xs = n+n)"
  hence "\<exists>n. length xs = Suc(n+n)" by arith
  then obtain n where l: "length xs = Suc(n+n)" by blast
  let ?ys = "take (Suc n) xs"
  let ?zs = "take n (drop (Suc n) xs)"
  have "xs = ?ys @ ?zs \<and> length ?ys = length ?zs + 1" by (simp add: l)
  thus ?thesis by blast
qed

end


(*  Title:      HOL/BNF_Cardinal_Arithmetic.thy
    Author:     Dmitriy Traytel, TU Muenchen
    Copyright   2012

Cardinal arithmetic as needed by bounded natural functors.
*)

section \<open>Cardinal Arithmetic as Needed by Bounded Natural Functors\<close>

theory BNF_Cardinal_Arithmetic
imports BNF_Cardinal_Order_Relation
begin

lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)

lemma card_order_dir_image:
  assumes bij: "bij f" and co: "card_order r"
  shows "card_order (dir_image r f)"
proof -
  from assms have "Field (dir_image r f) = UNIV"
    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
  with co have "Card_order (dir_image r f)"
    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
  ultimately show ?thesis by auto
qed

lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
by (rule card_order_on_ordIso)

lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)

lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
by (simp only: ordIso_refl card_of_Card_order)

lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
using card_order_on_Card_order[of UNIV r] by simp

subsection \<open>Zero\<close>

definition czero where
  "czero = card_of {}"

lemma czero_ordIso:
  "czero =o czero"
using card_of_empty_ordIso by (simp add: czero_def)

lemma card_of_ordIso_czero_iff_empty:
  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)

(* A "not czero" Cardinal predicate *)
abbreviation Cnotzero where
  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"

(*helper*)
lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
  unfolding Card_order_iff_ordIso_card_of czero_def by force

lemma czeroI:
  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast

lemma czeroE:
  "r =o czero \<Longrightarrow> Field r = {}"
unfolding czero_def
by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)

lemma Cnotzero_mono:
  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
apply (rule ccontr)
apply auto
apply (drule czeroE)
apply (erule notE)
apply (erule czeroI)
apply (drule card_of_mono2)
apply (simp only: card_of_empty3)
done

subsection \<open>(In)finite cardinals\<close>

definition cinfinite where
  "cinfinite r = (\<not> finite (Field r))"

abbreviation Cinfinite where
  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"

definition cfinite where
  "cfinite r = finite (Field r)"

abbreviation Cfinite where
  "Cfinite r \<equiv> cfinite r \<and> Card_order r"

lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
  unfolding cfinite_def cinfinite_def
  by (blast intro: finite_ordLess_infinite card_order_on_well_order_on)

lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]

lemma natLeq_cinfinite: "cinfinite natLeq"
unfolding cinfinite_def Field_natLeq by (rule infinite_UNIV_nat)

lemma natLeq_Cinfinite: "Cinfinite natLeq"
  using natLeq_cinfinite natLeq_Card_order by simp

lemma natLeq_ordLeq_cinfinite:
  assumes inf: "Cinfinite r"
  shows "natLeq \<le>o r"
proof -
  from inf have "natLeq \<le>o |Field r|" unfolding cinfinite_def
    using infinite_iff_natLeq_ordLeq by blast
  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
  finally show ?thesis .
qed

lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
unfolding cinfinite_def by (cases "Field r = {}") (auto dest: czeroE)

lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
by (rule conjI[OF cinfinite_not_czero]) simp_all

lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
using Card_order_ordIso2[of r1 r2] unfolding cinfinite_def ordIso_iff_ordLeq
by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])

lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
unfolding cinfinite_def by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])

lemma regularCard_ordIso:
assumes  "k =o k'" and "Cinfinite k" and "regularCard k"
shows "regularCard k'"
proof-
  have "stable k" using assms cinfinite_def regularCard_stable by blast
  hence "stable k'" using assms stable_ordIso1 ordIso_symmetric by blast
  thus ?thesis using assms cinfinite_def stable_regularCard
    using Cinfinite_cong by blast
qed

corollary card_of_UNION_ordLess_infinite_Field_regularCard:
assumes ST: "regularCard r" and INF: "Cinfinite r" and
        LEQ_I: "|I| <o r" and LEQ: "\<forall>i \<in> I. |A i| <o r"
      shows "|\<Union>i \<in> I. A i| <o r"
  using card_of_UNION_ordLess_infinite_Field regularCard_stable assms cinfinite_def by blast

subsection \<open>Binary sum\<close>

definition csum (infixr "+c" 65) where
  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"

lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
  unfolding csum_def Field_card_of by auto

lemma Card_order_csum:
  "Card_order (r1 +c r2)"
unfolding csum_def by (simp add: card_of_Card_order)

lemma csum_Cnotzero1:
  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
unfolding csum_def using Cnotzero_imp_not_empty[of r1] Plus_eq_empty_conv[of "Field r1" "Field r2"]
   card_of_ordIso_czero_iff_empty[of "Field r1 <+> Field r2"] by (auto intro: card_of_Card_order)

lemma card_order_csum:
  assumes "card_order r1" "card_order r2"
  shows "card_order (r1 +c r2)"
proof -
  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
qed

lemma cinfinite_csum:
  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
unfolding cinfinite_def csum_def by (auto simp: Field_card_of)

lemma Cinfinite_csum1:
  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
unfolding cinfinite_def csum_def by (rule conjI[OF _ card_of_Card_order]) (auto simp: Field_card_of)

lemma Cinfinite_csum:
  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
unfolding cinfinite_def csum_def by (rule conjI[OF _ card_of_Card_order]) (auto simp: Field_card_of)

lemma Cinfinite_csum_weak:
  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
by (erule Cinfinite_csum1)

lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
by (simp only: csum_def ordIso_Plus_cong)

lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
by (simp only: csum_def ordIso_Plus_cong1)

lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
by (simp only: csum_def ordIso_Plus_cong2)

lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
by (simp only: csum_def ordLeq_Plus_mono)

lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
by (simp only: csum_def ordLeq_Plus_mono1)

lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
by (simp only: csum_def ordLeq_Plus_mono2)

lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
by (simp only: csum_def Card_order_Plus1)

lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
by (simp only: csum_def Card_order_Plus2)

lemma csum_com: "p1 +c p2 =o p2 +c p1"
by (simp only: csum_def card_of_Plus_commute)

lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
by (simp only: csum_def Field_card_of card_of_Plus_assoc)

lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp

lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
proof -
  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
    by (rule csum_assoc)
  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
    by (intro csum_assoc csum_cong2 ordIso_symmetric)
  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
    by (intro csum_com csum_cong1 csum_cong2)
  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
    by (intro csum_assoc csum_cong2 ordIso_symmetric)
  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
    by (intro csum_assoc ordIso_symmetric)
  finally show ?thesis .
qed

lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
by (simp only: csum_def Field_card_of card_of_refl)

lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast

subsection \<open>One\<close>

definition cone where
  "cone = card_of {()}"

lemma Card_order_cone: "Card_order cone"
unfolding cone_def by (rule card_of_Card_order)

lemma Cfinite_cone: "Cfinite cone"
  unfolding cfinite_def by (simp add: Card_order_cone)

lemma cone_not_czero: "\<not> (cone =o czero)"
unfolding czero_def cone_def ordIso_iff_ordLeq using card_of_empty3 empty_not_insert by blast

lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
unfolding cone_def by (rule Card_order_singl_ordLeq) (auto intro: czeroI)

subsection \<open>Two\<close>

definition ctwo where
  "ctwo = |UNIV :: bool set|"

lemma Card_order_ctwo: "Card_order ctwo"
unfolding ctwo_def by (rule card_of_Card_order)

lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
unfolding czero_def ctwo_def using UNIV_not_empty by auto

lemma ctwo_Cnotzero: "Cnotzero ctwo"
by (simp add: ctwo_not_czero Card_order_ctwo)

subsection \<open>Family sum\<close>

definition Csum where
  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"

(* Similar setup to the one for SIGMA from theory Big_Operators: *)
syntax "_Csum" ::
  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
  ("(3CSUM _:_. _)" [0, 51, 10] 10)

translations
  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"

lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
by (auto simp: Csum_def Field_card_of)

(* NB: Always, under the cardinal operator,
operations on sets are reduced automatically to operations on cardinals.
This should make cardinal reasoning more direct and natural.  *)

subsection \<open>Product\<close>

definition cprod (infixr "*c" 80) where
  "r1 *c r2 = |Field r1 \<times> Field r2|"

lemma card_order_cprod:
  assumes "card_order r1" "card_order r2"
  shows "card_order (r1 *c r2)"
proof -
  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
qed

lemma Card_order_cprod: "Card_order (r1 *c r2)"
by (simp only: cprod_def Field_card_of card_of_card_order_on)

lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
by (simp only: cprod_def ordLeq_Times_mono1)

lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
by (simp only: cprod_def ordLeq_Times_mono2)

lemma cprod_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 *c p2 \<le>o r1 *c r2"
by (rule ordLeq_transitive[OF cprod_mono1 cprod_mono2])

lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
unfolding cprod_def by (rule Card_order_Times2) (auto intro: czeroI)

lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)

lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
by (rule cinfinite_mono) (auto intro: ordLeq_cprod2)

lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
by (blast intro: cinfinite_cprod2 Card_order_cprod)

lemma cprod_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 *c p2 =o r1 *c r2"
unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono)

lemma cprod_cong1: "\<lbrakk>p1 =o r1\<rbrakk> \<Longrightarrow> p1 *c p2 =o r1 *c p2"
unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono1)

lemma cprod_cong2: "p2 =o r2 \<Longrightarrow> q *c p2 =o q *c r2"
unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono2)

lemma cprod_com: "p1 *c p2 =o p2 *c p1"
by (simp only: cprod_def card_of_Times_commute)

lemma card_of_Csum_Times:
  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_mono1)

lemma card_of_Csum_Times':
  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
proof -
  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
  also from * have "|I| *c |Field r| \<le>o |I| *c r"
    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
  finally show ?thesis .
qed

lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)

lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
unfolding csum_def by (rule conjunct2[OF Card_order_Plus_infinite])
  (auto simp: cinfinite_def dest: cinfinite_mono)

lemma csum_absorb1':
  assumes card: "Card_order r2"
  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
  shows "r2 +c r1 =o r2"
by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)

lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
by (rule csum_absorb1') auto

lemma csum_absorb2: "\<lbrakk>Cinfinite r2 ; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
  using ordIso_transitive csum_com csum_absorb1 by blast

lemma regularCard_csum:
  assumes "Cinfinite r" "Cinfinite s" "regularCard r" "regularCard s"
    shows "regularCard (r +c s)"
proof (cases "r \<le>o s")
  case True
  then show ?thesis using regularCard_ordIso[of s] csum_absorb2'[THEN ordIso_symmetric] assms by auto
next
  case False
  have "Well_order s" "Well_order r" using assms card_order_on_well_order_on by auto
  then have "s \<le>o r" using not_ordLeq_iff_ordLess False ordLess_imp_ordLeq by auto
  then show ?thesis using regularCard_ordIso[of r] csum_absorb1'[THEN ordIso_symmetric] assms by auto
qed

lemma csum_mono_strict:
  assumes Card_order: "Card_order r" "Card_order q"
  and Cinfinite: "Cinfinite r'" "Cinfinite q'"
  and less: "r <o r'" "q <o q'"
shows "r +c q <o r' +c q'"
proof -
  have Well_order: "Well_order r" "Well_order q" "Well_order r'" "Well_order q'"
    using card_order_on_well_order_on Card_order Cinfinite by auto
  show ?thesis
  proof (cases "Cinfinite r")
    case outer: True
    then show ?thesis
    proof (cases "Cinfinite q")
      case inner: True
      then show ?thesis
      proof (cases "r \<le>o q")
        case True
        then have "r +c q =o q" using csum_absorb2 inner by blast
        then show ?thesis
          using ordIso_ordLess_trans ordLess_ordLeq_trans less Cinfinite ordLeq_csum2 by blast
      next
        case False
        then have "q \<le>o r" using not_ordLeq_iff_ordLess Well_order ordLess_imp_ordLeq by blast
        then have "r +c q =o r" using csum_absorb1 outer by blast
        then show ?thesis
          using ordIso_ordLess_trans ordLess_ordLeq_trans less Cinfinite ordLeq_csum1 by blast
      qed
    next
      case False
      then have "Cfinite q" using Card_order cinfinite_def cfinite_def by blast
      then have "q \<le>o r" using finite_ordLess_infinite cfinite_def cinfinite_def outer
          Well_order ordLess_imp_ordLeq by blast
      then have "r +c q =o r" by (rule csum_absorb1[OF outer])
      then show ?thesis using ordIso_ordLess_trans ordLess_ordLeq_trans less ordLeq_csum1 Cinfinite by blast
    qed
  next
    case False
    then have outer: "Cfinite r" using Card_order cinfinite_def cfinite_def by blast
    then show ?thesis
    proof (cases "Cinfinite q")
      case True
      then have "r \<le>o q" using finite_ordLess_infinite cinfinite_def cfinite_def outer Well_order
        ordLess_imp_ordLeq by blast
      then have "r +c q =o q" by (rule csum_absorb2[OF True])
      then show ?thesis using ordIso_ordLess_trans ordLess_ordLeq_trans less ordLeq_csum2 Cinfinite by blast
    next
      case False
      then have "Cfinite q" using Card_order cinfinite_def cfinite_def by blast
      then have "Cfinite (r +c q)" using Cfinite_csum outer by blast
      moreover have "Cinfinite (r' +c q')" using Cinfinite_csum1 Cinfinite by blast
      ultimately show ?thesis using Cfinite_ordLess_Cinfinite by blast
    qed
  qed
qed

subsection \<open>Exponentiation\<close>

definition cexp (infixr "^c" 90) where
  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"

lemma Card_order_cexp: "Card_order (r1 ^c r2)"
unfolding cexp_def by (rule card_of_Card_order)

lemma cexp_mono':
  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
  shows "p1 ^c p2 \<le>o r1 ^c r2"
proof(cases "Field p1 = {}")
  case True
  hence "Field p2 \<noteq> {} \<Longrightarrow> Func (Field p2) {} = {}" unfolding Func_is_emp by simp
  with True have "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
    unfolding cone_def Field_card_of
    by (cases "Field p2 = {}", auto intro: surj_imp_ordLeq simp: Func_empty)
  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
  thus ?thesis
  proof (cases "Field p2 = {}")
    case True
    with n have "Field r2 = {}" .
    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def
      by (auto intro: card_of_ordLeqI[where f="\<lambda>_ _. undefined"])
    thus ?thesis using \<open>p1 ^c p2 \<le>o cone\<close> ordLeq_transitive by auto
  next
    case False with True have "|Field (p1 ^c p2)| =o czero"
      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
      by (simp add: card_of_empty)
  qed
next
  case False
  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
    using 1 2 by (auto simp: card_of_mono2)
  obtain f1 where f1: "f1 ` Field r1 = Field p1"
    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
    using 2 unfolding card_of_ordLeq[symmetric] by blast
  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
    using False by simp
  show ?thesis
    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
qed

lemma cexp_mono:
  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
  shows "p1 ^c p2 \<le>o r1 ^c r2"
  by (rule cexp_mono'[OF 1 2 czeroE[OF n[OF czeroI[OF card]]]])

lemma cexp_mono1:
  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
  shows "p1 ^c q \<le>o r1 ^c q"
using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)

lemma cexp_mono2':
  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
  shows "q ^c p2 \<le>o q ^c r2"
using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto

lemma cexp_mono2:
  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
  shows "q ^c p2 \<le>o q ^c r2"
using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto

lemma cexp_mono2_Cnotzero:
  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
  shows "q ^c p2 \<le>o q ^c r2"
using assms(3) czeroI by (blast intro: cexp_mono2'[OF assms(1,2)])

lemma cexp_cong:
  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
  and Cr: "Card_order r2"
  and Cp: "Card_order p2"
  shows "p1 ^c p2 =o r1 ^c r2"
proof -
  obtain f where "bij_betw f (Field p2) (Field r2)"
    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
     using 0 Cr Cp czeroE czeroI by auto
  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by blast
qed

lemma cexp_cong1:
  assumes 1: "p1 =o r1" and q: "Card_order q"
  shows "p1 ^c q =o r1 ^c q"
by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])

lemma cexp_cong2:
  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
  shows "q ^c p2 =o q ^c r2"
by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)

lemma cexp_cone:
  assumes "Card_order r"
  shows "r ^c cone =o r"
proof -
  have "r ^c cone =o |Field r|"
    unfolding cexp_def cone_def Field_card_of Func_empty
      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
    by (rule exI[of _ "\<lambda>f. f ()"]) auto
  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
  finally show ?thesis .
qed

lemma cexp_cprod:
  assumes r1: "Card_order r1"
  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
proof -
  have "?L =o r1 ^c (r3 *c r2)"
    unfolding cprod_def cexp_def Field_card_of
    using card_of_Func_Times by(rule ordIso_symmetric)
  also have "r1 ^c (r3 *c r2) =o ?R"
    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
  finally show ?thesis .
qed

lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
unfolding cinfinite_def cprod_def
by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+

lemma cprod_infinite: "Cinfinite r \<Longrightarrow> r *c r =o r"
using cprod_infinite1' Cinfinite_Cnotzero ordLeq_refl by blast

lemma cexp_cprod_ordLeq:
  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
  and r3: "Cnotzero r3" "r3 \<le>o r2"
  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
proof-
  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
  also have "r1 ^c (r2 *c r3) =o ?R"
  apply(rule cexp_cong2)
  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
  finally show ?thesis .
qed

lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)

lemma ordLess_ctwo_cexp:
  assumes "Card_order r"
  shows "r <o ctwo ^c r"
proof -
  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
  also have "|Pow (Field r)| =o ctwo ^c r"
    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
  finally show ?thesis .
qed

lemma ordLeq_cexp1:
  assumes "Cnotzero r" "Card_order q"
  shows "q \<le>o q ^c r"
proof (cases "q =o (czero :: 'a rel)")
  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
next
  case False
  thus ?thesis
    apply -
    apply (rule ordIso_ordLeq_trans)
    apply (rule ordIso_symmetric)
    apply (rule cexp_cone)
    apply (rule assms(2))
    apply (rule cexp_mono2)
    apply (rule cone_ordLeq_Cnotzero)
    apply (rule assms(1))
    apply (rule assms(2))
    apply (rule notE)
    apply (rule cone_not_czero)
    apply assumption
    apply (rule Card_order_cone)
  done
qed

lemma ordLeq_cexp2:
  assumes "ctwo \<le>o q" "Card_order r"
  shows "r \<le>o q ^c r"
proof (cases "r =o (czero :: 'a rel)")
  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
next
  case False thus ?thesis
    apply -
    apply (rule ordLess_imp_ordLeq)
    apply (rule ordLess_ordLeq_trans)
    apply (rule ordLess_ctwo_cexp)
    apply (rule assms(2))
    apply (rule cexp_mono1)
    apply (rule assms(1))
    apply (rule assms(2))
  done
qed

lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
by (rule cinfinite_mono[OF ordLeq_cexp2]) simp_all

lemma Cinfinite_cexp:
  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
by (simp add: cinfinite_cexp Card_order_cexp)

lemma card_order_cexp:
  assumes "card_order r1" "card_order r2"
  shows "card_order (r1 ^c r2)"
proof -
  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
  thus ?thesis unfolding cexp_def Func_def using card_of_card_order_on by simp
qed

lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)

lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
by (rule ordLess_ordLeq_trans[OF ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite])

lemma ctwo_ordLeq_Cinfinite:
  assumes "Cinfinite r"
  shows "ctwo \<le>o r"
by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])

lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)

lemma Un_Cinfinite_bound_strict: "\<lbrakk>|A| <o r; |B| <o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| <o r"
by (auto simp add: cinfinite_def card_of_Un_ordLess_infinite_Field)

lemma UNION_Cinfinite_bound: "\<lbrakk>|I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |\<Union>i \<in> I. A i| \<le>o r"
by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)

lemma csum_cinfinite_bound:
  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
  shows "p +c q \<le>o r"
proof -
  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
  with assms show ?thesis unfolding cinfinite_def csum_def
    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
qed

lemma cprod_cinfinite_bound:
  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
  shows "p *c q \<le>o r"
proof -
  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
  with assms show ?thesis unfolding cinfinite_def cprod_def
    by (blast intro: card_of_Times_ordLeq_infinite_Field)
qed

lemma cprod_infinite2': "\<lbrakk>Cnotzero r1; Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r1 *c r2 =o r2"
  unfolding ordIso_iff_ordLeq
  by (intro conjI cprod_cinfinite_bound ordLeq_cprod2 ordLeq_refl)
    (auto dest!: ordIso_imp_ordLeq not_ordLeq_ordLess simp: czero_def Card_order_empty)

lemma regularCard_cprod:
  assumes "Cinfinite r" "Cinfinite s" "regularCard r" "regularCard s"
    shows "regularCard (r *c s)"
proof (cases "r \<le>o s")
  case True
  show ?thesis
    apply (rule regularCard_ordIso[of s])
      apply (rule ordIso_symmetric[OF cprod_infinite2'])
    using assms True Cinfinite_Cnotzero by auto
next
  case False
  have "Well_order r" "Well_order s" using assms card_order_on_well_order_on by auto
  then have 1: "s \<le>o r" using not_ordLeq_iff_ordLess ordLess_imp_ordLeq False by blast
  show ?thesis
    apply (rule regularCard_ordIso[of r])
      apply (rule ordIso_symmetric[OF cprod_infinite1'])
    using assms 1 Cinfinite_Cnotzero by auto
qed

lemma cprod_csum_cexp:
  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
proof -
  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
  moreover
  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
    by (auto simp: Func_def)
  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
qed

lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
by (intro cprod_cinfinite_bound)
  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])

lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)

lemma cprod_cexp_csum_cexp_Cinfinite:
  assumes t: "Cinfinite t"
  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
proof -
  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
    by (rule cexp_cprod[OF Card_order_csum])
  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
  finally show ?thesis .
qed

lemma Cfinite_cexp_Cinfinite:
  assumes s: "Cfinite s" and t: "Cinfinite t"
  shows "s ^c t \<le>o ctwo ^c t"
proof (cases "s \<le>o ctwo")
  case True thus ?thesis using t by (blast intro: cexp_mono1)
next
  case False
  hence "ctwo \<le>o s" using ordLeq_total[of s ctwo] Card_order_ctwo s
    by (auto intro: card_order_on_well_order_on)
  hence "Cnotzero s" using Cnotzero_mono[OF ctwo_Cnotzero] s by blast
  hence st: "Cnotzero (s *c t)" by (intro Cinfinite_Cnotzero[OF Cinfinite_cprod2]) (auto simp: t)
  have "s ^c t \<le>o (ctwo ^c s) ^c t"
    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
    by (blast intro: Card_order_ctwo cexp_cprod)
  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
  finally show ?thesis .
qed

lemma csum_Cfinite_cexp_Cinfinite:
  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
proof (cases "Cinfinite r")
  case True
  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
  finally show ?thesis .
next
  case False
  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
  finally show ?thesis .
qed

(* cardSuc *)

lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)

lemma cardSuc_UNION_Cinfinite:
  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (\<Union>i \<in> Field (cardSuc r). As i)" "|B| <=o r"
  shows "\<exists>i \<in> Field (cardSuc r). B \<le> As i"
using cardSuc_UNION assms unfolding cinfinite_def by blast

lemma Cinfinite_card_suc: "\<lbrakk> Cinfinite r ; card_order r \<rbrakk> \<Longrightarrow> Cinfinite (card_suc r)"
  using Cinfinite_cong[OF cardSuc_ordIso_card_suc Cinfinite_cardSuc] .

lemma card_suc_least: "\<lbrakk>card_order r; Card_order s; r <o s\<rbrakk> \<Longrightarrow> card_suc r \<le>o s"
  by (rule ordIso_ordLeq_trans[OF ordIso_symmetric[OF cardSuc_ordIso_card_suc]])
    (auto intro!: cardSuc_least simp: card_order_on_Card_order)

lemma regularCard_cardSuc: "Cinfinite k \<Longrightarrow> regularCard (cardSuc k)"
  by (rule infinite_cardSuc_regularCard) (auto simp: cinfinite_def)

lemma regularCard_card_suc: "card_order r \<Longrightarrow> Cinfinite r \<Longrightarrow> regularCard (card_suc r)"
  using cardSuc_ordIso_card_suc Cinfinite_cardSuc regularCard_cardSuc regularCard_ordIso
  by blast

end


(*
    File:      More_Totient.thy
    Author:    Manuel Eberl, TU München

    Additional properties of Euler's totient function
*)
section \<open>Euler's $\phi$ function\<close>
theory More_Totient
  imports
    Moebius_Mu
    "HOL-Number_Theory.Number_Theory"
begin

lemma fds_totient_times_zeta:
  "fds (\<lambda>n. of_nat (totient n) :: 'a :: comm_semiring_1) * fds_zeta = fds of_nat"
proof
  fix n :: nat assume n: "n > 0"
  have "fds_nth (fds (\<lambda>n. of_nat (totient n)) * fds_zeta) n =
          dirichlet_prod (\<lambda>n. of_nat (totient n)) (\<lambda>_. 1) n"
    by (simp add: fds_nth_mult)
  also from n have "\<dots> = fds_nth (fds of_nat) n"
    by (simp add: fds_nth_fds dirichlet_prod_def totient_divisor_sum of_nat_sum [symmetric]
             del: of_nat_sum)
  finally show "fds_nth (fds (\<lambda>n. of_nat (totient n)) * fds_zeta) n = fds_nth (fds of_nat) n" .
qed

lemma fds_totient_times_zeta': "fds totient * fds_zeta = fds id"
  using fds_totient_times_zeta[where 'a = nat] by simp

lemma fds_totient: "fds (\<lambda>n. of_nat (totient n)) = fds of_nat * fds moebius_mu"
proof -
  have "fds (\<lambda>n. of_nat (totient n)) * fds_zeta * fds moebius_mu = fds of_nat * fds moebius_mu"
    by (simp add: fds_totient_times_zeta)
  also have "fds (\<lambda>n. of_nat (totient n)) * fds_zeta * fds moebius_mu =
               fds (\<lambda>n. of_nat (totient n))"
    by (simp only: mult.assoc fds_zeta_times_moebius_mu mult_1_right)
  finally show ?thesis .
qed

lemma totient_conv_moebius_mu:
  "int (totient n) = dirichlet_prod moebius_mu int n"
proof (cases "n = 0")
  case False
  show ?thesis
    by (rule moebius_inversion)
       (insert False, simp_all add: of_nat_sum [symmetric] totient_divisor_sum del: of_nat_sum)
qed simp_all

interpretation totient: multiplicative_function totient
proof -
  have "multiplicative_function int" by standard simp_all
  hence "multiplicative_function (dirichlet_prod moebius_mu int)"
    by (intro multiplicative_dirichlet_prod moebius_mu.multiplicative_function_axioms)
  also have "dirichlet_prod moebius_mu int = (\<lambda>n. int (totient n))"
    by (simp add: fun_eq_iff totient_conv_moebius_mu)
  finally show "multiplicative_function totient" by (rule multiplicative_function_of_natD)
qed

lemma even_prime_nat: "prime p \<Longrightarrow> even p \<Longrightarrow> p = (2::nat)"
  using prime_odd_nat[of p] prime_gt_1_nat[of p] by (cases "p = 2") auto

lemma twopow_dvd_totient:
  fixes n :: nat
  assumes "n > 0"
  defines "k \<equiv> card {p\<in>prime_factors n. odd p}"
  shows   "2 ^ k dvd totient n"
proof -
  define P where "P = {p\<in>prime_factors n. odd p}"
  define P' where "P' = {p\<in>prime_factors n. even p}"
  define r where "r = (\<lambda>p. multiplicity p n)"
  from \<open>n > 0\<close> have "totient n = (\<Prod>p\<in>prime_factors n. totient (p ^ r p))"
    unfolding r_def by (rule totient.prod_prime_factors)
  also have "prime_factors n = P \<union> P'"
    by (auto simp: P_def P'_def)
  also have "(\<Prod>p\<in>\<dots>. totient (p ^ r p)) =
               (\<Prod>p\<in>P. totient (p ^ r p)) * (\<Prod>p\<in>P'. totient (p ^ r p))"
    by (subst prod.union_disjoint) (auto simp: P_def P'_def)
  finally have eq: "totient n = \<dots>" .

  have "p ^ r p > 2" if "p \<in> P" for p
  proof -
    have "p \<noteq> 2" using that by (auto simp: P_def)
    moreover have "p > 1" using prime_gt_1_nat[of p] that by (auto simp: P_def)
    ultimately have "2 < p" by linarith
    also have "p = p ^ 1" by simp
    also have "p ^ 1 \<le> p ^ r p"
      using that prime_gt_1_nat[of p]
      by (intro power_increasing) (auto simp: P_def prime_factors_multiplicity r_def)
    finally show ?thesis .
  qed
  hence "(\<Prod>p\<in>P. 2) dvd (\<Prod>p\<in>P. totient (p ^ r p))"
    by (intro prod_dvd_prod totient_even)
  hence "2 ^ card P dvd (\<Prod>p\<in>P. totient (p ^ r p))"
    by simp
  also have "\<dots> dvd (\<Prod>p\<in>P. totient (p ^ r p)) * (\<Prod>p\<in>P'. totient (p ^ r p))"
    by simp
  also have "\<dots> = totient n"
    by (rule eq [symmetric])
  finally show ?thesis unfolding k_def P_def .
qed

lemma totient_conv_moebius_mu':
  assumes "n > (0::nat)"
  shows   "real (totient n) = real n * (\<Sum>d | d dvd n. moebius_mu d / real d)"
proof -
  have "real (totient n) = of_int (int (totient n))" by simp
  also have "int (totient n) = (\<Sum>d | d dvd n. moebius_mu d * int (n div d))"
    using totient_conv_moebius_mu by (simp add: dirichlet_prod_def assms)
  also have "real_of_int (\<Sum>d | d dvd n. moebius_mu d * int (n div d)) =
               (\<Sum>d | d dvd n. moebius_mu d * real (n div d))" by simp
  also have "\<dots> = (\<Sum>d | d dvd n. real n * moebius_mu d / real d)"
    by (rule sum.cong) (simp_all add: field_char_0_class.of_nat_div)
  also have "\<dots> = real n * (\<Sum>d | d dvd n. moebius_mu d / real d)"
    by (simp add: sum_distrib_left)
  finally show ?thesis .
qed

lemma totient_prime_power_Suc:
  assumes "prime p"
  shows   "totient (p ^ Suc n) = p ^ Suc n - p ^ n"
proof -
  have "totient (p ^ Suc n) = p ^ Suc n - card ((*) p ` {0<..p ^ n})"
    unfolding totient_def totatives_prime_power_Suc[OF assms]
    by (subst card_Diff_subset) (insert assms, auto simp: prime_gt_0_nat)
  also from assms have "card ((*) p ` {0<..p^n}) = p ^ n"
    by (subst card_image) (auto simp: inj_on_def)
  finally show ?thesis .
qed

interpretation totient: multiplicative_function' totient "\<lambda>p k. p ^ k - p ^ (k - 1)" "\<lambda>p. p - 1"
proof
  fix p k :: nat assume "prime p" "k > 0"
  thus "totient (p ^ k) = p ^ k - p ^ (k - 1)"
    by (cases k) (simp_all add: totient_prime_power_Suc del: power_Suc)
qed simp_all

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               November 2004               |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                  March 2006  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2016         |
            |                    May 2016  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2020         |
            |                  April 2020  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Norm_seq
imports CMS
begin

(*****************************************************************

         1. Definition of Normarized sequences
         2. Properties of Normarized sequences
         3. How to transform each Cauchy sequence to NF
         4. The same limit between xs and NF(xs)

 *****************************************************************)

definition
  normal :: "'a::ms infinite_seq => bool"
  where
  normal_def :
    "normal xs == ALL (n::nat) (m::nat).
        distance(xs n, xs m) <= (1/2)^(min n m)"

definition
  Nset   :: "'a::ms infinite_seq => real => nat set"
  where
  Nset_def :
    "Nset xs delta ==
     {N. ALL n m. (N <= m & N <= n) --> distance(xs n, xs m) <= delta}"

definition
  Nmin   :: "'a::ms infinite_seq => real => nat"
  where
  Nmin_def :
    "Nmin xs delta == Min (Nset xs delta)"

definition
  NF     :: "'a::ms infinite_seq => 'a::ms infinite_seq"
  where
  NF_def :
    "NF xs == (%n. xs (Nmin xs ((1/2)^n)))"

(********************************************************************
                          Normalization
 ********************************************************************)

(*** normalized sequence --> Cauchy sequence ***)

lemma normal_cauchy: "normal xs ==> cauchy xs"

  apply (simp add: cauchy_def)
  apply (intro allI impI)
  apply (subgoal_tac "EX n. (1/2) ^ n < delta")
  apply (erule exE)
  apply (rule_tac x="n" in exI)
  apply (intro allI impI)
  apply (simp add: normal_def)
  apply (drule_tac x="i" in spec)
  apply (drule_tac x="j" in spec)

  apply (rule le_less_trans)   (* modified for Isabelle2020 *)
  apply (simp)
  apply (rule le_less_trans[of _ "(1 / 2) ^ _"])
  apply (simp)
  apply (simp)
  apply (simp add: pow_convergence)
done

(*
declare realpow_Suc          [simp del]
in isabelle2008
*)

declare power_Suc          [simp del]

lemma normal_Limit:
  "[| normal xs ; xs convergeTo y |]
        ==> distance(xs (Suc n), y) < (1/2)^n"
apply (simp add: convergeTo_def)
apply (drule_tac x="(1/2)^(Suc n)" in spec)
apply (simp)
apply (erule exE)

apply (rename_tac N)
apply (case_tac "N <= Suc n")
 apply (drule_tac x="Suc n" in spec)
 apply (simp add: symmetry_ms)

 apply (rule less_le_trans)   (* modified for Isabelle2020 *)
 apply (simp)
 apply (subgoal_tac "((1::real) / 2) ^ Suc n <= (1 / 2) ^ n")
 apply (simp)
 apply (simp add: power_decreasing)

(* else (i.e. Suc n < N *)
 apply (drule_tac x="N" in spec)
 apply (simp)
 apply (insert triangle_inequality_ms)
 apply (drule_tac x="xs (Suc n)" in spec)
 apply (drule_tac x="xs N" in spec)
 apply (drule_tac x="y" in spec)

 apply (simp add: normal_def)
 apply (drule_tac x="Suc n" in spec)
 apply (drule_tac x="N" in spec)
 apply (simp add: symmetry_ms)
 apply (simp add: min_def)
 apply (simp add: power_Suc)
done

(*
declare realpow_Suc          [simp]
*)
declare power_Suc          [simp]

(********************************************************************
                                Nmin
 ********************************************************************)

(*** Nmin exists ***)

lemma Nmin_exists:
  "[| 0 < delta ; cauchy xs |] ==> EX N. N isMIN (Nset xs delta)"
apply (simp add: cauchy_def)
apply (drule_tac x="delta" in spec)
apply (simp)
apply (erule exE)

apply (rule EX_MIN_nat)
apply (simp add: Nset_def)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (drule_tac x="na" in spec)
apply (drule_tac x="m" in spec)
by (simp)

lemma Nset_hasMIN:
  "[| 0 < delta ; cauchy xs |] ==> (Nset xs delta) hasMIN"
apply (simp add: hasMIN_def)
apply (rule Nmin_exists)
by (simp)

(*** Nmin unique ***)

lemma Nmin_unique:
  "[| N isMIN (Nset xs delta) ; M isMIN (Nset xs delta) |] ==> N = M"
by (simp add: MIN_unique)

(*-----------------------*
 |       the Nmin        |
 *-----------------------*)

lemma Nset_to_Nmin :
  "[| 0 < delta ; cauchy xs |]
   ==> (N isMIN (Nset xs delta)) = (Nmin xs delta = N)"
apply (simp add: Nmin_def)
apply (rule iffI)

apply (simp add: Min_def Nset_hasMIN)
apply (rule the_equality)
apply (simp)
apply (simp add: Nmin_unique)

by (simp add: MIN_iff Nset_hasMIN)

lemmas Nmin_to_Nset = Nset_to_Nmin[THEN sym]

lemma Nmin_to_Nset_sym :
    "[| 0 < delta ; cauchy xs |]
     ==> (N = Nmin xs delta) = (N isMIN (Nset xs delta))"
by (auto simp add: Nset_to_Nmin)

lemmas Nmin_iff = Nmin_to_Nset Nmin_to_Nset_sym

(*-----------------------*
 |      property         |
 *-----------------------*)

lemma Nmin_cauchy_lm:
  "[| 0 < delta ; cauchy xs ; Nmin xs delta = N |]
   ==> (ALL n m. (N <= m & N <= n) --> distance(xs n, xs m) <= delta)"
by (simp add: Nmin_iff Nset_def isMIN_def)

lemma Nmin_cauchy:
  "[| 0 < delta ; cauchy xs ; Nmin xs delta <= m ; Nmin xs delta <= n |]
   ==> distance(xs n, xs m) <= delta"
by (simp add: Nmin_cauchy_lm)

(*-----------------------*
 |   min_number_cauchy   |
 *-----------------------*)

(*** Nmin order (check) ***)

lemma min_number_cauchy_lm:
  "[| 0 < delta1 ; delta1 <= delta2 ; cauchy xs |]
   ==> Nset xs delta1 <= Nset xs delta2"
apply (simp add: Nset_def)
apply (rule subsetI)
apply (simp)
apply (intro allI impI)
apply (drule_tac x="n" in spec)
apply (drule_tac x="m" in spec)
by (simp)

(*** Nmin order ***)

lemma min_number_cauchy:
  "[| 0 < delta1 ; delta1 <= delta2 ; cauchy xs ;
      Nmin xs delta1 = N1 ; Nmin xs delta2 = N2 |]
   ==> N2 <= N1"
apply (simp add: Nmin_iff)
by (simp add: isMIN_subset min_number_cauchy_lm)

(*** Nmin order half ***)

lemma min_number_cauchy_half:
  "[| n <= m ; cauchy xs ; Nmin xs ((1/2)^n) = N1 ; Nmin xs ((1/2)^m) = N2 |]
   ==> N1 <= N2"
apply (rule min_number_cauchy)
by (simp_all add: power_decreasing)

(*------------------------*
 | normal_form_seq_normal |
 *------------------------*)

lemma normal_form_seq_normal: "cauchy xs ==> normal (NF(xs))"
apply (simp add: normal_def NF_def)
apply (intro allI)

apply (case_tac "n <= m")
 apply (simp add: min_def)
 apply (rule Nmin_cauchy, simp_all)
 apply (rule min_number_cauchy_half, simp_all)

(* else *)
 apply (simp add: min_def)
 apply (rule Nmin_cauchy, simp_all)
 apply (rule min_number_cauchy_half, simp_all)
done

(*----------------------------*
 | normal_form_seq_same_Limit |
 *----------------------------*)

(*** only if part ***)

lemma normal_form_seq_same_Limit_only_if:
  "[| cauchy xs ; xs convergeTo y |] ==> NF(xs) convergeTo y"
apply (simp add: convergeTo_def)
apply (intro allI impI)
apply (drule_tac x="eps/2" in spec)
apply (simp)
apply (erule exE)

apply (subgoal_tac "EX n. (1 / 2) ^ n < eps/2")
apply (erule exE)
apply (rename_tac eps N M)

apply (rule_tac x="M" in exI)
apply (intro allI impI)

apply (case_tac "N <= Nmin xs ((1/2)^m)")

 apply (drule_tac x="Nmin xs ((1/2)^m)" in spec)
 apply (simp add: NF_def)

(* else *)
 apply (insert triangle_inequality_ms)
 apply (drule_tac x="y" in spec)
 apply (drule_tac x="xs N" in spec)
 apply (drule_tac x="(NF xs) m" in spec)

 apply (drule_tac x="N" in spec)
 apply (simp add: NF_def)

 apply (subgoal_tac "distance (xs N, xs (Nmin xs ((1 / 2) ^ m))) <= (1 / 2) ^ m")
 apply (subgoal_tac "((1::real) / 2) ^ m <= (1 / 2) ^ M")
 apply (simp (no_asm_simp))  (* modified for Isabelle2020 *)
 apply (simp)
 apply (rule Nmin_cauchy)
 apply (simp, simp, simp, simp)
 apply (rule pow_convergence)
 apply (simp_all)
done

(*** if part ***)

lemma normal_form_seq_same_Limit_if:
  "[| cauchy xs ; NF (xs) convergeTo y |] ==> xs convergeTo y"
apply (simp add: convergeTo_def)
apply (intro allI impI)
apply (drule_tac x="eps/2" in spec)
apply (simp)
apply (erule exE)

apply (subgoal_tac "EX n. (1 / 2) ^ n < eps/2")
apply (erule exE)
apply (rename_tac eps N M)

apply (rule_tac x="Nmin xs ((1/2)^(max N M))" in exI)
apply (intro allI impI)

apply (insert triangle_inequality_ms)
apply (drule_tac x="y" in spec)
apply (drule_tac x="xs (Nmin xs ((1/2)^(max N M)))" in spec)
apply (drule_tac x="xs m" in spec)

apply (drule_tac x="max N M" in spec)
(* apply (simp add: le_maxI1) *)
apply (simp add: NF_def)

(* *)
 apply (subgoal_tac
   "distance(xs (Nmin xs ((1 / 2) ^ max N M)), xs m) <= (1 / 2) ^ max N M")
 apply (subgoal_tac "((1::real) / 2) ^ max N M <= (1 / 2) ^ M")
 apply (simp (no_asm_simp) add: max_def power_decreasing)   (* modified for 2020 *)
 apply (simp)

 apply (rule Nmin_cauchy)
 apply (simp, simp, simp, simp)
 apply (rule pow_convergence)
 apply (simp_all)
done

(*** iff ***)

lemma normal_form_seq_same_Limit:
  "cauchy xs ==> xs convergeTo y = NF(xs) convergeTo y"
apply (rule iffI)
apply (simp add: normal_form_seq_same_Limit_only_if)
apply (simp add: normal_form_seq_same_Limit_if)
done

end