section \<open> Defining Runs \<close>

theory Run
imports TESL

begin
text \<open>
  Runs are sequences of instants, and each instant maps a clock to a pair
  @{term \<open>(h, t)\<close>} where @{term \<open>h\<close>} indicates whether the clock ticks or not,
  and @{term \<open>t\<close>} is the current time on this clock.
  The first element of the pair is called the \<^emph>\<open>hamlet\<close> of the clock (to tick or
  not to tick), the second element is called the \<^emph>\<open>time\<close>.
\<close>

abbreviation hamlet where \<open>hamlet \<equiv> fst\<close>
abbreviation time   where \<open>time \<equiv> snd\<close>

type_synonym '\<tau> instant = \<open>clock \<Rightarrow> (bool \<times> '\<tau> tag_const)\<close>

text\<open>
  Runs have the additional constraint that time cannot go backwards on any clock
  in the sequence of instants.
  Therefore, for any clock, the time projection of a run is monotonous.
\<close>
typedef (overloaded) '\<tau>::linordered_field run =
  \<open>{ \<rho>::nat \<Rightarrow> '\<tau> instant. \<forall>c. mono (\<lambda>n. time (\<rho> n c)) }\<close>
proof
  show \<open>(\<lambda>_ _. (True, \<tau>\<^sub>c\<^sub>s\<^sub>t 0)) \<in> {\<rho>. \<forall>c. mono (\<lambda>n. time (\<rho> n c))}\<close>
    unfolding mono_def by blast
qed

lemma Abs_run_inverse_rewrite:
  \<open>\<forall>c. mono (\<lambda>n. time (\<rho> n c)) \<Longrightarrow> Rep_run (Abs_run \<rho>) = \<rho>\<close>
by (simp add: Abs_run_inverse)

text \<open>
  A \<^emph>\<open>dense\<close> run is a run in which something happens (at least one clock ticks)
  at every instant.
\<close>
definition \<open>dense_run \<rho> \<equiv> (\<forall>n. \<exists>c. hamlet ((Rep_run \<rho>) n c))\<close>

text\<open>
  @{term \<open>run_tick_count \<rho> K n\<close>} counts the number of ticks on clock @{term \<open>K\<close>}
  in the interval \<^verbatim>\<open>[0, n]\<close> of run @{term \<open>\<rho>\<close>}.
\<close>
fun run_tick_count :: \<open>('\<tau>::linordered_field) run \<Rightarrow> clock \<Rightarrow> nat \<Rightarrow> nat\<close>
  (\<open>#\<^sub>\<le> _ _ _\<close>)
where
  \<open>(#\<^sub>\<le> \<rho> K 0)       = (if hamlet ((Rep_run \<rho>) 0 K)
                       then 1
                       else 0)\<close>
| \<open>(#\<^sub>\<le> \<rho> K (Suc n)) = (if hamlet ((Rep_run \<rho>) (Suc n) K)
                       then 1 + (#\<^sub>\<le> \<rho> K n)
                       else (#\<^sub>\<le> \<rho> K n))\<close>

text\<open>
  @{term \<open>run_tick_count_strictly \<rho> K n\<close>} counts the number of ticks on
  clock @{term \<open>K\<close>} in the interval \<^verbatim>\<open>[0, n[\<close> of run @{term \<open>\<rho>\<close>}.
\<close>
fun run_tick_count_strictly :: \<open>('\<tau>::linordered_field) run \<Rightarrow> clock \<Rightarrow> nat \<Rightarrow> nat\<close>
  (\<open>#\<^sub>< _ _ _\<close>)
where
  \<open>(#\<^sub>< \<rho> K 0)       = 0\<close>
| \<open>(#\<^sub>< \<rho> K (Suc n)) = #\<^sub>\<le> \<rho> K n\<close>

text\<open>
  @{term \<open>first_time \<rho> K n \<tau>\<close>} tells whether instant @{term \<open>n\<close>} in run @{term\<open>\<rho>\<close>}
  is the first one where the time on clock @{term \<open>K\<close>} reaches @{term \<open>\<tau>\<close>}.
\<close>
definition first_time :: \<open>'a::linordered_field run \<Rightarrow> clock \<Rightarrow> nat \<Rightarrow> 'a tag_const
                          \<Rightarrow> bool\<close>
where
  \<open>first_time \<rho> K n \<tau> \<equiv> (time ((Rep_run \<rho>) n K) = \<tau>)
                      \<and> (\<nexists>n'. n' < n \<and> time ((Rep_run \<rho>) n' K) = \<tau>)\<close>

text\<open>
  The time on a clock is necessarily less than @{term \<open>\<tau>\<close>} before the first instant
  at which it reaches @{term \<open>\<tau>\<close>}.
\<close>
lemma before_first_time:
  assumes \<open>first_time \<rho> K n \<tau>\<close>
      and \<open>m < n\<close>
    shows \<open>time ((Rep_run \<rho>) m K) < \<tau>\<close>
proof -
  have \<open>mono (\<lambda>n. time (Rep_run \<rho> n K))\<close> using Rep_run by blast
  moreover from assms(2) have \<open>m \<le> n\<close> using less_imp_le by simp
  moreover have \<open>mono (\<lambda>n. time (Rep_run \<rho> n K))\<close> using Rep_run by blast
  ultimately have  \<open>time ((Rep_run \<rho>) m K) \<le> time ((Rep_run \<rho>) n K)\<close>
    by (simp add:mono_def)
  moreover from assms(1) have \<open>time ((Rep_run \<rho>) n K) = \<tau>\<close>
    using first_time_def by blast
  moreover from assms have \<open>time ((Rep_run \<rho>) m K) \<noteq> \<tau>\<close>
    using first_time_def by blast
  ultimately show ?thesis by simp
qed

text\<open>
  This leads to an alternate definition of @{term \<open>first_time\<close>}:
\<close>
lemma alt_first_time_def:
  assumes \<open>\<forall>m < n. time ((Rep_run \<rho>) m K) < \<tau>\<close>
      and \<open>time ((Rep_run \<rho>) n K) = \<tau>\<close>
    shows \<open>first_time \<rho> K n \<tau>\<close>
proof -
  from assms(1) have \<open>\<forall>m < n. time ((Rep_run \<rho>) m K) \<noteq> \<tau>\<close>
    by (simp add: less_le)
  with assms(2) show ?thesis by (simp add: first_time_def)
qed

end


section \<open> Integer Powers \<close>

theory Power_int
  imports "HOL.Real"
begin

text \<open> The standard HOL power operator is only for natural powers. This operator allows integers. \<close>

definition intpow :: "'a::{linordered_field} \<Rightarrow> int \<Rightarrow> 'a" (infixr "^\<^sub>Z" 80) where
"intpow x n = (if (n < 0) then inverse (x ^ nat (-n)) else (x ^ nat n))"

lemma intpow_zero [simp]: "x ^\<^sub>Z 0 = 1"
  by (simp add: intpow_def)

lemma intpow_spos [simp]: "x > 0 \<Longrightarrow> x ^\<^sub>Z n > 0"
  by (simp add: intpow_def)

lemma intpow_one [simp]: "x ^\<^sub>Z 1 = x"
  by (simp add: intpow_def)

lemma intpow_plus: "x > 0 \<Longrightarrow> x ^\<^sub>Z (m + n) = x ^\<^sub>Z m * x ^\<^sub>Z n"
  apply (simp add: intpow_def field_simps power_add)
  apply (metis (no_types, hide_lams) abs_ge_zero add.commute add_diff_cancel_right' nat_add_distrib power_add uminus_add_conv_diff zabs_def)
  done

lemma intpow_mult_combine: "x > 0 \<Longrightarrow> x ^\<^sub>Z m * (x ^\<^sub>Z n * y) = x ^\<^sub>Z (m + n) * y"
  by (simp add: intpow_plus)

lemma intpow_pos [simp]: "n \<ge> 0 \<Longrightarrow> x ^\<^sub>Z n = x ^ nat n"
  by (simp add: intpow_def)

lemma intpow_uminus: "x ^\<^sub>Z -n = inverse (x ^\<^sub>Z n)"
  by (simp add: intpow_def)

lemma intpow_uminus_nat: "n \<ge> 0 \<Longrightarrow> x ^\<^sub>Z -n = inverse (x ^ nat n)"
  by (simp add: intpow_def)

lemma intpow_inverse: "inverse a ^\<^sub>Z n = inverse (a ^\<^sub>Z n)"
  by (simp add: intpow_def power_inverse)

lemma intpow_mult_distrib: "(x * y) ^\<^sub>Z m = x ^\<^sub>Z m * y ^\<^sub>Z m"
  by (simp add: intpow_def power_mult_distrib)

end


(* Samuel Balco and Alexander Kurz, Sept 2018 *)

section "Arithmetic Expressions"

theory NumExp imports Main "HOL-Eisbach.Eisbach" begin

subsection "Arithmetic Expressions"

(* num ::= 1 | num + 1
   exp ::= num | exp + exp | exp * exp *)

datatype num = One ("\<one>") | S num ("_+\<one>")
datatype exp = Num num ("\<langle>_\<rangle>") | Plus exp exp (infix ":+:" 14) | Mult exp exp (infix ":*:" 15)

fun eval_num :: "num \<Rightarrow> int" where
"eval_num \<one> = 1" |
"eval_num (num+\<one>) = (eval_num num) + 1"

value "eval_num \<one>"
value "eval_num (\<one>+\<one>+\<one>)"

fun eval_exp :: "exp \<Rightarrow> int" where
"eval_exp \<langle>num\<rangle> = eval_num num" |
"eval_exp (a\<^sub>1 :+: a\<^sub>2) = eval_exp a\<^sub>1 + (eval_exp a\<^sub>2)" |
"eval_exp (a\<^sub>1 :*: a\<^sub>2) = eval_exp a\<^sub>1 * (eval_exp a\<^sub>2)"

value "eval_exp (Plus (Num (S One)) (Num One))"

value "eval_exp (\<langle>\<one>+\<one>\<rangle> :+: \<langle>\<one>+\<one>\<rangle> :*: \<langle>\<one>+\<one>+\<one>\<rangle>)"

value "eval_exp (Mult (Num (S One)) (Num One))"

(* the following is easy because addition in integers is commutative *)
(* so after evaluation, there is not much to prove *)
lemma "eval_exp (e\<^sub>1 :+: e\<^sub>2) = eval_exp (e\<^sub>2 :+: e\<^sub>1)"
  by auto

(* but can we prove commutativity on the syntactic side? *)
(* we need to assume something, that captures that Plus is addition *)
(* in our simple situation, associativity is enough *)

inductive equal_exp :: "exp \<Rightarrow> exp \<Rightarrow> bool" (infix "\<equiv>ex" 13) where
equal_exp_refl:         "e \<equiv>ex e" |
equal_exp_symm:         "e\<^sub>1 \<equiv>ex e\<^sub>2 \<Longrightarrow> e\<^sub>2 \<equiv>ex e\<^sub>1" |
equal_exp_trans[trans]: "e\<^sub>1 \<equiv>ex e\<^sub>2 \<Longrightarrow> e\<^sub>2 \<equiv>ex e\<^sub>3 \<Longrightarrow> e\<^sub>1 \<equiv>ex e\<^sub>3" |
equal_exp_cong_plus:    "e\<^sub>1 \<equiv>ex e\<^sub>1' \<Longrightarrow> e\<^sub>2 \<equiv>ex e\<^sub>2' \<Longrightarrow> e\<^sub>1 :+: e\<^sub>2 \<equiv>ex e\<^sub>1' :+: e\<^sub>2'" |
equal_exp_plusone:      "\<langle>n+\<one>\<rangle> \<equiv>ex \<langle>n\<rangle> :+: \<langle>\<one>\<rangle>" |
equal_exp_assoc:        "(e\<^sub>1 :+: (e\<^sub>2 :+: e\<^sub>3)) \<equiv>ex ((e\<^sub>1 :+: e\<^sub>2) :+: e\<^sub>3)"

lemma plusone: "\<langle>\<one>\<rangle> :+: \<langle>n\<rangle> \<equiv>ex \<langle>n\<rangle> :+: \<langle>\<one>\<rangle>"
(* Show 1+n=n+1 by induction on n:
   If n=1, then 1+1=1+1
   If n=Sm, then 1+n = 1+Sm = 1+(m+1) = (1+m)+1 = (m+1)+1 = Sm+1 = n+1
*)
  apply (induction n)

  apply (rule equal_exp_refl)

  apply(rule equal_exp_trans)
  apply(rule equal_exp_cong_plus)
  apply(rule equal_exp_refl)
   apply(rule equal_exp_plusone)

  apply(rule equal_exp_trans)
  apply(rule equal_exp_assoc)
  apply(rule equal_exp_trans)
  apply(rule equal_exp_cong_plus)
  apply simp
   apply(rule equal_exp_refl)

  apply(rule equal_exp_cong_plus)
  apply(rule equal_exp_symm)
  apply(rule equal_exp_plusone)
   apply(rule equal_exp_refl)
  done

(* We want to show that n+m=m+n, or, Plus n m = Plus m n, which again needs to be written as
   "equal_exp (Plus (Num n) (Num m)) (Plus (Num m) (Num n))" to be understood by Isabelle  *)
lemma commutativity_num: "\<langle>n\<rangle> :+: \<langle>m\<rangle> \<equiv>ex \<langle>m\<rangle> :+: \<langle>n\<rangle>"
(* Induction on m:
   If n=1, then we need to show 1+m=m+1, which we proved in lemma plusone
   If n = Sl, then
    n+m = Sl+m = (l+1)+m = (1+l)+m = 1+(l+m) = 1+(m+l) = (1+m)+l = (m+1)+l
     = m+(1+l) = m+(l+1) =  m+n
*)
proof(induction n)
case One
  then show ?case by (rule plusone)
next
  case (S l)
  have "\<langle>l+\<one>\<rangle> :+: \<langle>m\<rangle> \<equiv>ex (\<langle>l\<rangle> :+: \<langle>\<one>\<rangle>) :+: \<langle>m\<rangle>"
    apply(rule equal_exp_cong_plus)
    apply(rule equal_exp_plusone)
    by(rule equal_exp_refl)
  also have      "\<dots> \<equiv>ex (\<langle>\<one>\<rangle> :+: \<langle>l\<rangle>) :+: \<langle>m\<rangle>"
    apply(rule equal_exp_cong_plus)
    apply(rule equal_exp_symm)
    apply(rule plusone)
    by(rule equal_exp_refl)
  also have      "\<dots> \<equiv>ex \<langle>\<one>\<rangle> :+: (\<langle>l\<rangle> :+: \<langle>m\<rangle>)"
    apply(rule equal_exp_symm)
    by(rule equal_exp_assoc)
  also have      "\<dots> \<equiv>ex \<langle>\<one>\<rangle> :+: (\<langle>m\<rangle> :+: \<langle>l\<rangle>)"
    apply(rule equal_exp_cong_plus)
    apply(rule equal_exp_refl)
    by(rule S)
  also have      "\<dots> \<equiv>ex (\<langle>\<one>\<rangle> :+: \<langle>m\<rangle>) :+: \<langle>l\<rangle>"
    by(rule equal_exp_assoc)
  also have      "\<dots> \<equiv>ex (\<langle>m\<rangle> :+: \<langle>\<one>\<rangle>) :+: \<langle>l\<rangle>"
    apply(rule equal_exp_cong_plus)
    apply(rule plusone)
    by(rule equal_exp_refl)
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: (\<langle>\<one>\<rangle> :+: \<langle>l\<rangle>)"
    apply(rule equal_exp_symm)
    by(rule equal_exp_assoc)
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: (\<langle>l\<rangle> :+: \<langle>\<one>\<rangle>)"
    apply(rule equal_exp_cong_plus)
    apply(rule equal_exp_refl)
    by(rule plusone)
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: \<langle>l+\<one>\<rangle>"
    apply(rule equal_exp_cong_plus)
    apply(rule equal_exp_refl)
    apply(rule equal_exp_symm)
    by(rule equal_exp_plusone)
  finally show ?case by simp
qed

(*I've added a simple tactic called exp_tac, which simply tries
all* the rules on a goal in this order:

1) try refl
2) try plusone
3) try symmetry and then plusone
...
6) try split on n + m and recursively try to solve n and m
7) try custom derived rule
8) try symmetry and then custom rule

*this tactic does not apply the trans rule for obvious reasons
*)

method exp_tac uses rule =
    rule equal_exp_refl |
    rule equal_exp_plusone |
    (rule equal_exp_symm ; rule equal_exp_plusone) |
    rule equal_exp_assoc |
    (rule equal_exp_symm ; rule equal_exp_assoc) |
    (rule equal_exp_cong_plus ; (exp_tac rule:rule)+) |
    rule rule  |
    (rule equal_exp_symm ; rule rule)

lemma plusone_isar: "\<langle>\<one>\<rangle> :+: \<langle>n\<rangle> \<equiv>ex \<langle>n\<rangle> :+: \<langle>\<one>\<rangle>"
(* Show 1+n=n+1 by induction on n:
   If n=1, then 1+1=1+1
   If n=Sm, then 1+n = 1+Sm = 1+(m+1) = (1+m)+1 = (m+1)+1 = Sm+1 = n+1
*)
proof (induction n)
  case One
  then show ?case by (simp add: equal_exp_refl)
next
  case (S m)
  have "\<langle>\<one>\<rangle> :+: \<langle>m+\<one>\<rangle> \<equiv>ex \<langle>\<one>\<rangle> :+: (\<langle>m\<rangle> :+: \<langle>\<one>\<rangle>)" by exp_tac
  also have      "\<dots> \<equiv>ex (\<langle>\<one>\<rangle> :+: \<langle>m\<rangle>) :+: \<langle>\<one>\<rangle>" by exp_tac
  also have      "\<dots> \<equiv>ex (\<langle>m\<rangle> :+: \<langle>\<one>\<rangle>) :+: \<langle>\<one>\<rangle>" by(exp_tac rule:S)
  also have      "\<dots> \<equiv>ex (\<langle>m+\<one>\<rangle>) :+: \<langle>\<one>\<rangle>" by exp_tac
  finally show ?case by simp
qed

lemma commutativity_num': "\<langle>n\<rangle> :+: \<langle>m\<rangle> \<equiv>ex \<langle>m\<rangle> :+: \<langle>n\<rangle>"
(* Induction on m:
   If n=1, then we need to show 1+m=m+1, which we proved in lemma plusone
   If n = Sl, then
    n+m = Sl+m = (l+1)+m = (1+l)+m = 1+(l+m) = 1+(m+l) = (1+m)+l = (m+1)+l
     = m+(1+l) = m+(l+1) =  m+n
*)
proof(induction n)
case One
  then show ?case by (rule plusone)
next
  case (S l)
  have "\<langle>l+\<one>\<rangle> :+: \<langle>m\<rangle> \<equiv>ex (\<langle>l\<rangle> :+: \<langle>\<one>\<rangle>) :+: \<langle>m\<rangle>" by exp_tac
  also have      "\<dots> \<equiv>ex (\<langle>\<one>\<rangle> :+: \<langle>l\<rangle>) :+: \<langle>m\<rangle>" by(exp_tac rule:plusone)
  also have      "\<dots> \<equiv>ex \<langle>\<one>\<rangle> :+: (\<langle>l\<rangle> :+: \<langle>m\<rangle>)" by exp_tac
  also have      "\<dots> \<equiv>ex \<langle>\<one>\<rangle> :+: (\<langle>m\<rangle> :+: \<langle>l\<rangle>)" by(exp_tac rule:S)
  also have      "\<dots> \<equiv>ex (\<langle>\<one>\<rangle> :+: \<langle>m\<rangle>) :+: \<langle>l\<rangle>" by exp_tac
  also have      "\<dots> \<equiv>ex (\<langle>m\<rangle> :+: \<langle>\<one>\<rangle>) :+: \<langle>l\<rangle>" by(exp_tac rule:plusone)
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: (\<langle>\<one>\<rangle> :+: \<langle>l\<rangle>)" by exp_tac
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: (\<langle>l\<rangle> :+: \<langle>\<one>\<rangle>)" by(exp_tac rule:plusone)
  also have      "\<dots> \<equiv>ex \<langle>m\<rangle> :+: \<langle>l+\<one>\<rangle>" by exp_tac
  finally show ?case by simp
qed

end


(*  Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com> *)

section \<open>Cardinality of Multisets\<close>

theory Card_Multisets
imports
  "HOL-Library.Multiset"
begin

subsection \<open>Additions to Multiset Theory\<close>

lemma mset_set_set_mset_subseteq:
  "mset_set (set_mset M) \<subseteq># M"
proof (induct M)
  case empty
  show ?case by simp
next
  case (add x M)
  from this show ?case
  proof (cases "x \<in># M")
    assume "x \<in># M"
    from this have "mset_set (set_mset (M + {#x#})) = mset_set (set_mset M)"
      by (simp add: insert_absorb)
    from this add.hyps show ?thesis
      using subset_mset.order.trans by fastforce
  next
    assume "\<not> x \<in># M"
    from this add.hyps have "{#x#} + mset_set (set_mset M) \<subseteq># M + {#x#}"
      by (simp add: insert_subset_eq_iff)
    from this \<open>\<not> x \<in># M\<close> show ?thesis by simp
  qed
qed

lemma size_mset_set_eq_card:
  assumes "finite A"
  shows "size (mset_set A) = card A"
using assms by (induct A) auto

lemma card_set_mset_leq:
  "card (set_mset M) \<le> size M"
by (induct M) (auto simp add: card_insert_le_m1)

subsection \<open>Lemma to Enumerate Sets of Multisets\<close>

lemma set_of_multisets_eq:
  assumes "x \<notin> A"
  shows "{M. set_mset M \<subseteq> insert x A \<and> size M = Suc k} =
    {M. set_mset M \<subseteq> A \<and> size M = Suc k} \<union>
    (\<lambda>M. M + {#x#}) ` {M. set_mset M \<subseteq> insert x A \<and> size M = k}"
proof -
  from \<open>x \<notin> A\<close> have "{M. set_mset M \<subseteq> insert x A \<and> size M = Suc k} =
    {M. set_mset M \<subseteq> A \<and> size M = Suc k} \<union>
    {M. set_mset M \<subseteq> insert x A \<and> size M = Suc k \<and> x \<in># M}"
    by auto
  moreover have "{M. set_mset M \<subseteq> insert x A \<and> size M = Suc k \<and> x \<in># M} =
    (\<lambda>M. M + {#x#}) ` {M. set_mset M \<subseteq> insert x A \<and> size M = k}" (is "?S = ?T")
  proof
    show "?S \<subseteq> ?T"
    proof
      fix M
      assume "M \<in> ?S"
      from this have "M = M - {#x#} + {#x#}" by auto
      moreover have "M - {#x#} \<in> {M. set_mset M \<subseteq> insert x A \<and> size M = k}"
      proof -
        have "set_mset (M - {#x#} + {#x#}) \<subseteq> insert x A"
          using \<open>M \<in> ?S\<close> by force
        moreover have "size (M - {#x#} + {#x#}) = Suc k \<and> x \<in># M - {#x#} + {#x#}"
          using \<open>M \<in> ?S\<close> by force
        ultimately show ?thesis by force
      qed
      ultimately show "M \<in> ?T" by auto
    qed
  next
    show "?T \<subseteq> ?S" by force
  qed
  ultimately show ?thesis by auto
qed

subsection \<open>Derivation of Suitable Induction Rule\<close>

context
begin

private inductive R :: "'a set \<Rightarrow> nat \<Rightarrow> bool"
where
  "finite A \<Longrightarrow> R A 0"
| "R {} k"
| "finite A \<Longrightarrow> x \<notin> A \<Longrightarrow> R A (Suc k) \<Longrightarrow> R (insert x A) k \<Longrightarrow> R (insert x A) (Suc k)"

private lemma R_eq_finite:
  "R A k \<longleftrightarrow> finite A"
proof
  assume "R A k"
  from this show "finite A" by cases auto
next
  assume "finite A"
  from this show "R A k"
  proof (induct A)
    case empty
    from this show ?case by (rule R.intros(2))
  next
    case insert
    from this show ?case
    proof (induct k)
      case 0
      from this show ?case
        by (intro R.intros(1) finite.insertI)
    next
      case Suc
      from this show ?case
        by (metis R.simps Zero_neq_Suc diff_Suc_1)
    qed
  qed
qed

lemma finite_set_and_nat_induct[consumes 1, case_names zero empty step]:
  assumes "finite A"
  assumes "\<And>A. finite A \<Longrightarrow> P A 0"
  assumes "\<And>k. P {} k"
  assumes "\<And>A k x. finite A \<Longrightarrow> x \<notin> A \<Longrightarrow> P A (Suc k) \<Longrightarrow> P (insert x A) k \<Longrightarrow> P (insert x A) (Suc k)"
  shows "P A k"
proof -
  from \<open>finite A\<close> have "R A k" by (subst R_eq_finite)
  from this assms(2-4) show ?thesis by (induct A k) auto
qed

end

subsection \<open>Finiteness of Sets of Multisets\<close>

lemma finite_multisets:
  assumes "finite A"
  shows "finite {M. set_mset M \<subseteq> A \<and> size M = k}"
using assms
proof (induct A k rule: finite_set_and_nat_induct)
  case zero
  from this show ?case by auto
next
  case empty
  from this show ?case by auto
next
  case (step A k x)
  from this show ?case
    using set_of_multisets_eq[OF \<open>x \<notin> A\<close>] by simp
qed

subsection \<open>Cardinality of Multisets\<close>

lemma card_multisets:
  assumes "finite A"
  shows "card {M. set_mset M \<subseteq> A \<and> size M = k} = (card A + k - 1) choose k"
using assms
proof (induct A k rule: finite_set_and_nat_induct)
  case (zero A)
  assume "finite (A :: 'a set)"
  have "{M. set_mset M \<subseteq> A \<and> size M = 0} = {{#}}" by auto
  from this show "card {M. set_mset M \<subseteq> A \<and> size M = 0} = card A + 0 - 1 choose 0"
    by simp
next
  case (empty k)
  show "card {M. set_mset M \<subseteq> {} \<and> size M = k} = card {} + k - 1 choose k"
    by (cases k) (auto simp add: binomial_eq_0)
next
  case (step A k x)
  let ?S\<^sub>1 = "{M. set_mset M \<subseteq> A \<and> size M = Suc k}"
  and ?S\<^sub>2 = "{M. set_mset M \<subseteq> insert x A \<and> size M = k}"
  assume hyps1: "card ?S\<^sub>1 = card A + Suc k - 1 choose Suc k"
  assume hyps2: "card ?S\<^sub>2 = card (insert x A) + k - 1 choose k"
  have finite_sets: "finite ?S\<^sub>1" "finite ((\<lambda>M. M + {#x#}) ` ?S\<^sub>2)"
    using \<open>finite A\<close> by (auto simp add: finite_multisets)
  have inj: "inj_on (\<lambda>M. M + {#x#}) ?S\<^sub>2" by (rule inj_onI) auto
  have "card {M. set_mset M \<subseteq> insert x A \<and> size M = Suc k} =
    card (?S\<^sub>1 \<union> (\<lambda>M. M + {#x#}) ` ?S\<^sub>2)"
    using set_of_multisets_eq \<open>x \<notin> A\<close> by fastforce
  also have "\<dots> = card ?S\<^sub>1 + card ((\<lambda>M. M + {#x#}) ` ?S\<^sub>2)"
    using finite_sets \<open>x \<notin> A\<close> by (subst card_Un_disjoint) auto
  also have "\<dots> = card ?S\<^sub>1 + card ?S\<^sub>2"
    using inj by (auto intro: card_image)
  also have "\<dots> = card A + Suc k - 1 choose Suc k + (card (insert x A) + k - 1 choose k)"
    using hyps1 hyps2 by simp
  also have "\<dots> = card (insert x A) + Suc k - 1 choose Suc k"
    using \<open>x \<notin> A\<close> \<open>finite A\<close> by simp
  finally show ?case .
qed

lemma card_too_small_multisets_covering_set:
  assumes "finite A"
  assumes "k < card A"
  shows "card {M. set_mset M = A \<and> size M = k} = 0"
proof -
  from \<open>k < card A\<close> have eq: "{M. set_mset M = A \<and> size M = k} = {}"
    using card_set_mset_leq Collect_empty_eq leD by auto
  from this show ?thesis by (metis card_empty)
qed

lemma card_multisets_covering_set:
  assumes "finite A"
  assumes "card A \<le> k"
  shows "card {M. set_mset M = A \<and> size M = k} = (k - 1) choose (k - card A)"
proof -
  have "{M. set_mset M = A \<and> size M = k} = (\<lambda>M. M + mset_set A) `
    {M. set_mset M \<subseteq> A \<and> size M = k - card A}" (is "?S = ?f ` ?T")
  proof
    show "?S \<subseteq> ?f ` ?T"
    proof
      fix M
      assume "M \<in> ?S"
      from this have "M = M - mset_set A + mset_set A"
        by (auto simp add: mset_set_set_mset_subseteq subset_mset.diff_add)
      moreover from \<open>M \<in> ?S\<close> have "M - mset_set A \<in> ?T"
        by (auto simp add: mset_set_set_mset_subseteq size_Diff_submset size_mset_set_eq_card in_diffD)
      ultimately show "M \<in> ?f ` ?T" by auto
    qed
  next
    from \<open>finite A\<close> \<open>card A \<le> k\<close> show "?f ` ?T \<subseteq> ?S"
      by (auto simp add: size_mset_set_eq_card)+
  qed
  moreover have "inj_on ?f ?T" by (rule inj_onI) auto
  ultimately have "card ?S = card ?T" by (simp add: card_image)
  also have "\<dots> = card A + (k - card A) - 1 choose (k - card A)"
    using \<open>finite A\<close> by (simp only: card_multisets)
  also have "\<dots> = (k - 1) choose (k - card A)"
    using \<open>card A \<le> k\<close> by auto
  finally show ?thesis .
qed

end


(*  Author: John Harrison, Marco Maggesi, Graziano Gentili, Gianni Ciolli, Valentina Bruno
    Ported from "hol_light/Multivariate/canal.ml" by L C Paulson (2014)
*)

section {* Complex Analysis Basics *}

theory Complex_Analysis_Basics
imports  "~~/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space"
begin

subsection{*General lemmas*}

lemma has_derivative_mult_right:
  fixes c:: "'a :: real_normed_algebra"
  shows "((op * c) has_derivative (op * c)) F"
by (rule has_derivative_mult_right [OF has_derivative_id])

lemma has_derivative_of_real[derivative_intros, simp]:
  "(f has_derivative f') F \<Longrightarrow> ((\<lambda>x. of_real (f x)) has_derivative (\<lambda>x. of_real (f' x))) F"
  using bounded_linear.has_derivative[OF bounded_linear_of_real] .

lemma has_vector_derivative_real_complex:
  "DERIV f (of_real a) :> f' \<Longrightarrow> ((\<lambda>x. f (of_real x)) has_vector_derivative f') (at a)"
  using has_derivative_compose[of of_real of_real a UNIV f "op * f'"]
  by (simp add: scaleR_conv_of_real ac_simps has_vector_derivative_def has_field_derivative_def)

lemma fact_cancel:
  fixes c :: "'a::real_field"
  shows "of_nat (Suc n) * c / of_nat (fact (Suc n)) = c / of_nat (fact n)"
  by (simp add: of_nat_mult del: of_nat_Suc times_nat.simps)

lemma linear_times:
  fixes c::"'a::real_algebra" shows "linear (\<lambda>x. c * x)"
  by (auto simp: linearI distrib_left)

lemma bilinear_times:
  fixes c::"'a::real_algebra" shows "bilinear (\<lambda>x y::'a. x*y)"
  by (auto simp: bilinear_def distrib_left distrib_right intro!: linearI)

lemma linear_cnj: "linear cnj"
  using bounded_linear.linear[OF bounded_linear_cnj] .

lemma tendsto_mult_left:
  fixes c::"'a::real_normed_algebra"
  shows "(f ---> l) F \<Longrightarrow> ((\<lambda>x. c * (f x)) ---> c * l) F"
by (rule tendsto_mult [OF tendsto_const])

lemma tendsto_mult_right:
  fixes c::"'a::real_normed_algebra"
  shows "(f ---> l) F \<Longrightarrow> ((\<lambda>x. (f x) * c) ---> l * c) F"
by (rule tendsto_mult [OF _ tendsto_const])

lemma tendsto_Re_upper:
  assumes "~ (trivial_limit F)"
          "(f ---> l) F"
          "eventually (\<lambda>x. Re(f x) \<le> b) F"
    shows  "Re(l) \<le> b"
  by (metis assms tendsto_le [OF _ tendsto_const]  tendsto_Re)

lemma tendsto_Re_lower:
  assumes "~ (trivial_limit F)"
          "(f ---> l) F"
          "eventually (\<lambda>x. b \<le> Re(f x)) F"
    shows  "b \<le> Re(l)"
  by (metis assms tendsto_le [OF _ _ tendsto_const]  tendsto_Re)

lemma tendsto_Im_upper:
  assumes "~ (trivial_limit F)"
          "(f ---> l) F"
          "eventually (\<lambda>x. Im(f x) \<le> b) F"
    shows  "Im(l) \<le> b"
  by (metis assms tendsto_le [OF _ tendsto_const]  tendsto_Im)

lemma tendsto_Im_lower:
  assumes "~ (trivial_limit F)"
          "(f ---> l) F"
          "eventually (\<lambda>x. b \<le> Im(f x)) F"
    shows  "b \<le> Im(l)"
  by (metis assms tendsto_le [OF _ _ tendsto_const]  tendsto_Im)

lemma lambda_zero: "(\<lambda>h::'a::mult_zero. 0) = op * 0"
  by auto

lemma lambda_one: "(\<lambda>x::'a::monoid_mult. x) = op * 1"
  by auto

lemma has_real_derivative:
  fixes f :: "real \<Rightarrow> real"
  assumes "(f has_derivative f') F"
  obtains c where "(f has_real_derivative c) F"
proof -
  obtain c where "f' = (\<lambda>x. x * c)"
    by (metis assms has_derivative_bounded_linear real_bounded_linear)
  then show ?thesis
    by (metis assms that has_field_derivative_def mult_commute_abs)
qed

lemma has_real_derivative_iff:
  fixes f :: "real \<Rightarrow> real"
  shows "(\<exists>c. (f has_real_derivative c) F) = (\<exists>D. (f has_derivative D) F)"
  by (metis has_field_derivative_def has_real_derivative)

lemma continuous_mult_left:
  fixes c::"'a::real_normed_algebra"
  shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. c * f x)"
by (rule continuous_mult [OF continuous_const])

lemma continuous_mult_right:
  fixes c::"'a::real_normed_algebra"
  shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. f x * c)"
by (rule continuous_mult [OF _ continuous_const])

lemma continuous_on_mult_left:
  fixes c::"'a::real_normed_algebra"
  shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. c * f x)"
by (rule continuous_on_mult [OF continuous_on_const])

lemma continuous_on_mult_right:
  fixes c::"'a::real_normed_algebra"
  shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. f x * c)"
by (rule continuous_on_mult [OF _ continuous_on_const])

lemma uniformly_continuous_on_cmul_right [continuous_intros]:
  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
  shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s (\<lambda>x. f x * c)"
  using bounded_linear.uniformly_continuous_on[OF bounded_linear_mult_left] .

lemma uniformly_continuous_on_cmul_left[continuous_intros]:
  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
  assumes "uniformly_continuous_on s f"
    shows "uniformly_continuous_on s (\<lambda>x. c * f x)"
by (metis assms bounded_linear.uniformly_continuous_on bounded_linear_mult_right)

lemma continuous_within_norm_id [continuous_intros]: "continuous (at x within S) norm"
  by (rule continuous_norm [OF continuous_ident])

lemma continuous_on_norm_id [continuous_intros]: "continuous_on S norm"
  by (intro continuous_on_id continuous_on_norm)

subsection{*DERIV stuff*}

lemma DERIV_zero_connected_constant:
  fixes f :: "'a::{real_normed_field,euclidean_space} \<Rightarrow> 'a"
  assumes "connected s"
      and "open s"
      and "finite k"
      and "continuous_on s f"
      and "\<forall>x\<in>(s - k). DERIV f x :> 0"
    obtains c where "\<And>x. x \<in> s \<Longrightarrow> f(x) = c"
using has_derivative_zero_connected_constant [OF assms(1-4)] assms
by (metis DERIV_const has_derivative_const Diff_iff at_within_open frechet_derivative_at has_field_derivative_def)

lemma DERIV_zero_constant:
  fixes f :: "'a::{real_normed_field, real_inner} \<Rightarrow> 'a"
  shows    "\<lbrakk>convex s;
             \<And>x. x\<in>s \<Longrightarrow> (f has_field_derivative 0) (at x within s)\<rbrakk>
             \<Longrightarrow> \<exists>c. \<forall>x \<in> s. f(x) = c"
  by (auto simp: has_field_derivative_def lambda_zero intro: has_derivative_zero_constant)

lemma DERIV_zero_unique:
  fixes f :: "'a::{real_normed_field, real_inner} \<Rightarrow> 'a"
  assumes "convex s"
      and d0: "\<And>x. x\<in>s \<Longrightarrow> (f has_field_derivative 0) (at x within s)"
      and "a \<in> s"
      and "x \<in> s"
    shows "f x = f a"
  by (rule has_derivative_zero_unique [OF assms(1) _ assms(4,3)])
     (metis d0 has_field_derivative_imp_has_derivative lambda_zero)

lemma DERIV_zero_connected_unique:
  fixes f :: "'a::{real_normed_field, real_inner} \<Rightarrow> 'a"
  assumes "connected s"
      and "open s"
      and d0: "\<And>x. x\<in>s \<Longrightarrow> DERIV f x :> 0"
      and "a \<in> s"
      and "x \<in> s"
    shows "f x = f a"
    by (rule has_derivative_zero_unique_connected [OF assms(2,1) _ assms(5,4)])
       (metis has_field_derivative_def lambda_zero d0)

lemma DERIV_transform_within:
  assumes "(f has_field_derivative f') (at a within s)"
      and "0 < d" "a \<in> s"
      and "\<And>x. x\<in>s \<Longrightarrow> dist x a < d \<Longrightarrow> f x = g x"
    shows "(g has_field_derivative f') (at a within s)"
  using assms unfolding has_field_derivative_def
  by (blast intro: has_derivative_transform_within)

lemma DERIV_transform_within_open:
  assumes "DERIV f a :> f'"
      and "open s" "a \<in> s"
      and "\<And>x. x\<in>s \<Longrightarrow> f x = g x"
    shows "DERIV g a :> f'"
  using assms unfolding has_field_derivative_def
by (metis has_derivative_transform_within_open)

lemma DERIV_transform_at:
  assumes "DERIV f a :> f'"
      and "0 < d"
      and "\<And>x. dist x a < d \<Longrightarrow> f x = g x"
    shows "DERIV g a :> f'"
  by (blast intro: assms DERIV_transform_within)

subsection {*Some limit theorems about real part of real series etc.*}

(*MOVE? But not to Finite_Cartesian_Product*)
lemma sums_vec_nth :
  assumes "f sums a"
  shows "(\<lambda>x. f x $ i) sums a $ i"
using assms unfolding sums_def
by (auto dest: tendsto_vec_nth [where i=i])

lemma summable_vec_nth :
  assumes "summable f"
  shows "summable (\<lambda>x. f x $ i)"
using assms unfolding summable_def
by (blast intro: sums_vec_nth)

subsection {*Complex number lemmas *}

lemma
  shows open_halfspace_Re_lt: "open {z. Re(z) < b}"
    and open_halfspace_Re_gt: "open {z. Re(z) > b}"
    and closed_halfspace_Re_ge: "closed {z. Re(z) \<ge> b}"
    and closed_halfspace_Re_le: "closed {z. Re(z) \<le> b}"
    and closed_halfspace_Re_eq: "closed {z. Re(z) = b}"
    and open_halfspace_Im_lt: "open {z. Im(z) < b}"
    and open_halfspace_Im_gt: "open {z. Im(z) > b}"
    and closed_halfspace_Im_ge: "closed {z. Im(z) \<ge> b}"
    and closed_halfspace_Im_le: "closed {z. Im(z) \<le> b}"
    and closed_halfspace_Im_eq: "closed {z. Im(z) = b}"
  by (intro open_Collect_less closed_Collect_le closed_Collect_eq isCont_Re
            isCont_Im isCont_ident isCont_const)+

lemma closed_complex_Reals: "closed (Reals :: complex set)"
proof -
  have "(Reals :: complex set) = {z. Im z = 0}"
    by (auto simp: complex_is_Real_iff)
  then show ?thesis
    by (metis closed_halfspace_Im_eq)
qed

lemma real_lim:
  fixes l::complex
  assumes "(f ---> l) F" and "~(trivial_limit F)" and "eventually P F" and "\<And>a. P a \<Longrightarrow> f a \<in> \<real>"
  shows  "l \<in> \<real>"
proof (rule Lim_in_closed_set[OF closed_complex_Reals _ assms(2,1)])
  show "eventually (\<lambda>x. f x \<in> \<real>) F"
    using assms(3, 4) by (auto intro: eventually_mono)
qed

lemma real_lim_sequentially:
  fixes l::complex
  shows "(f ---> l) sequentially \<Longrightarrow> (\<exists>N. \<forall>n\<ge>N. f n \<in> \<real>) \<Longrightarrow> l \<in> \<real>"
by (rule real_lim [where F=sequentially]) (auto simp: eventually_sequentially)

lemma real_series:
  fixes l::complex
  shows "f sums l \<Longrightarrow> (\<And>n. f n \<in> \<real>) \<Longrightarrow> l \<in> \<real>"
unfolding sums_def
by (metis real_lim_sequentially setsum_in_Reals)

lemma Lim_null_comparison_Re:
  assumes "eventually (\<lambda>x. norm(f x) \<le> Re(g x)) F" "(g ---> 0) F" shows "(f ---> 0) F"
  by (rule Lim_null_comparison[OF assms(1)] tendsto_eq_intros assms(2))+ simp

subsection{*Holomorphic functions*}

definition complex_differentiable :: "[complex \<Rightarrow> complex, complex filter] \<Rightarrow> bool"
           (infixr "(complex'_differentiable)" 50)
  where "f complex_differentiable F \<equiv> \<exists>f'. (f has_field_derivative f') F"

lemma complex_differentiable_imp_continuous_at:
    "f complex_differentiable (at x within s) \<Longrightarrow> continuous (at x within s) f"
  by (metis DERIV_continuous complex_differentiable_def)

lemma complex_differentiable_within_subset:
    "\<lbrakk>f complex_differentiable (at x within s); t \<subseteq> s\<rbrakk>
     \<Longrightarrow> f complex_differentiable (at x within t)"
  by (metis DERIV_subset complex_differentiable_def)

lemma complex_differentiable_at_within:
    "\<lbrakk>f complex_differentiable (at x)\<rbrakk>
     \<Longrightarrow> f complex_differentiable (at x within s)"
  unfolding complex_differentiable_def
  by (metis DERIV_subset top_greatest)

lemma complex_differentiable_linear: "(op * c) complex_differentiable F"
proof -
  show ?thesis
    unfolding complex_differentiable_def has_field_derivative_def mult_commute_abs
    by (force intro: has_derivative_mult_right)
qed

lemma complex_differentiable_const: "(\<lambda>z. c) complex_differentiable F"
  unfolding complex_differentiable_def has_field_derivative_def
  by (rule exI [where x=0])
     (metis has_derivative_const lambda_zero)

lemma complex_differentiable_ident: "(\<lambda>z. z) complex_differentiable F"
  unfolding complex_differentiable_def has_field_derivative_def
  by (rule exI [where x=1])
     (simp add: lambda_one [symmetric])

lemma complex_differentiable_id: "id complex_differentiable F"
  unfolding id_def by (rule complex_differentiable_ident)

lemma complex_differentiable_minus:
  "f complex_differentiable F \<Longrightarrow> (\<lambda>z. - (f z)) complex_differentiable F"
  using assms unfolding complex_differentiable_def
  by (metis field_differentiable_minus)

lemma complex_differentiable_add:
  assumes "f complex_differentiable F" "g complex_differentiable F"
    shows "(\<lambda>z. f z + g z) complex_differentiable F"
  using assms unfolding complex_differentiable_def
  by (metis field_differentiable_add)

lemma complex_differentiable_setsum:
  "(\<And>i. i \<in> I \<Longrightarrow> (f i) complex_differentiable F) \<Longrightarrow> (\<lambda>z. \<Sum>i\<in>I. f i z) complex_differentiable F"
  by (induct I rule: infinite_finite_induct)
     (auto intro: complex_differentiable_add complex_differentiable_const)

lemma complex_differentiable_diff:
  assumes "f complex_differentiable F" "g complex_differentiable F"
    shows "(\<lambda>z. f z - g z) complex_differentiable F"
  using assms unfolding complex_differentiable_def
  by (metis field_differentiable_diff)

lemma complex_differentiable_inverse:
  assumes "f complex_differentiable (at a within s)" "f a \<noteq> 0"
  shows "(\<lambda>z. inverse (f z)) complex_differentiable (at a within s)"
  using assms unfolding complex_differentiable_def
  by (metis DERIV_inverse_fun)

lemma complex_differentiable_mult:
  assumes "f complex_differentiable (at a within s)"
          "g complex_differentiable (at a within s)"
    shows "(\<lambda>z. f z * g z) complex_differentiable (at a within s)"
  using assms unfolding complex_differentiable_def
  by (metis DERIV_mult [of f _ a s g])

lemma complex_differentiable_divide:
  assumes "f complex_differentiable (at a within s)"
          "g complex_differentiable (at a within s)"
          "g a \<noteq> 0"
    shows "(\<lambda>z. f z / g z) complex_differentiable (at a within s)"
  using assms unfolding complex_differentiable_def
  by (metis DERIV_divide [of f _ a s g])

lemma complex_differentiable_power:
  assumes "f complex_differentiable (at a within s)"
    shows "(\<lambda>z. f z ^ n) complex_differentiable (at a within s)"
  using assms unfolding complex_differentiable_def
  by (metis DERIV_power)

lemma complex_differentiable_transform_within:
  "0 < d \<Longrightarrow>
        x \<in> s \<Longrightarrow>
        (\<And>x'. x' \<in> s \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') \<Longrightarrow>
        f complex_differentiable (at x within s)
        \<Longrightarrow> g complex_differentiable (at x within s)"
  unfolding complex_differentiable_def has_field_derivative_def
  by (blast intro: has_derivative_transform_within)

lemma complex_differentiable_compose_within:
  assumes "f complex_differentiable (at a within s)"
          "g complex_differentiable (at (f a) within f`s)"
    shows "(g o f) complex_differentiable (at a within s)"
  using assms unfolding complex_differentiable_def
  by (metis DERIV_image_chain)

lemma complex_differentiable_compose:
  "f complex_differentiable at z \<Longrightarrow> g complex_differentiable at (f z)
          \<Longrightarrow> (g o f) complex_differentiable at z"
by (metis complex_differentiable_at_within complex_differentiable_compose_within)

lemma complex_differentiable_within_open:
     "\<lbrakk>a \<in> s; open s\<rbrakk> \<Longrightarrow> f complex_differentiable at a within s \<longleftrightarrow>
                          f complex_differentiable at a"
  unfolding complex_differentiable_def
  by (metis at_within_open)

subsection{*Caratheodory characterization.*}

lemma complex_differentiable_caratheodory_at:
  "f complex_differentiable (at z) \<longleftrightarrow>
         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z) g)"
  using CARAT_DERIV [of f]
  by (simp add: complex_differentiable_def has_field_derivative_def)

lemma complex_differentiable_caratheodory_within:
  "f complex_differentiable (at z within s) \<longleftrightarrow>
         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z within s) g)"
  using DERIV_caratheodory_within [of f]
  by (simp add: complex_differentiable_def has_field_derivative_def)

subsection{*Holomorphic*}

definition holomorphic_on :: "[complex \<Rightarrow> complex, complex set] \<Rightarrow> bool"
           (infixl "(holomorphic'_on)" 50)
  where "f holomorphic_on s \<equiv> \<forall>x\<in>s. f complex_differentiable (at x within s)"

lemma holomorphic_on_empty: "f holomorphic_on {}"
  by (simp add: holomorphic_on_def)

lemma holomorphic_on_open:
    "open s \<Longrightarrow> f holomorphic_on s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>f'. DERIV f x :> f')"
  by (auto simp: holomorphic_on_def complex_differentiable_def has_field_derivative_def at_within_open [of _ s])

lemma holomorphic_on_imp_continuous_on:
    "f holomorphic_on s \<Longrightarrow> continuous_on s f"
  by (metis complex_differentiable_imp_continuous_at continuous_on_eq_continuous_within holomorphic_on_def)

lemma holomorphic_on_subset:
    "f holomorphic_on s \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f holomorphic_on t"
  unfolding holomorphic_on_def
  by (metis complex_differentiable_within_subset subsetD)

lemma holomorphic_transform: "\<lbrakk>f holomorphic_on s; \<And>x. x \<in> s \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g holomorphic_on s"
  by (metis complex_differentiable_transform_within linordered_field_no_ub holomorphic_on_def)

lemma holomorphic_cong: "s = t ==> (\<And>x. x \<in> s \<Longrightarrow> f x = g x) \<Longrightarrow> f holomorphic_on s \<longleftrightarrow> g holomorphic_on t"
  by (metis holomorphic_transform)

lemma holomorphic_on_linear: "(op * c) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_linear)

lemma holomorphic_on_const: "(\<lambda>z. c) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_const)

lemma holomorphic_on_ident: "(\<lambda>x. x) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_ident)

lemma holomorphic_on_id: "id holomorphic_on s"
  unfolding id_def by (rule holomorphic_on_ident)

lemma holomorphic_on_compose:
  "f holomorphic_on s \<Longrightarrow> g holomorphic_on (f ` s) \<Longrightarrow> (g o f) holomorphic_on s"
  using complex_differentiable_compose_within[of f _ s g]
  by (auto simp: holomorphic_on_def)

lemma holomorphic_on_compose_gen:
  "f holomorphic_on s \<Longrightarrow> g holomorphic_on t \<Longrightarrow> f ` s \<subseteq> t \<Longrightarrow> (g o f) holomorphic_on s"
  by (metis holomorphic_on_compose holomorphic_on_subset)

lemma holomorphic_on_minus: "f holomorphic_on s \<Longrightarrow> (\<lambda>z. -(f z)) holomorphic_on s"
  by (metis complex_differentiable_minus holomorphic_on_def)

lemma holomorphic_on_add:
  "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z + g z) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_add)

lemma holomorphic_on_diff:
  "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z - g z) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_diff)

lemma holomorphic_on_mult:
  "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_mult)

lemma holomorphic_on_inverse:
  "\<lbrakk>f holomorphic_on s; \<And>z. z \<in> s \<Longrightarrow> f z \<noteq> 0\<rbrakk> \<Longrightarrow> (\<lambda>z. inverse (f z)) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_inverse)

lemma holomorphic_on_divide:
  "\<lbrakk>f holomorphic_on s; g holomorphic_on s; \<And>z. z \<in> s \<Longrightarrow> g z \<noteq> 0\<rbrakk> \<Longrightarrow> (\<lambda>z. f z / g z) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_divide)

lemma holomorphic_on_power:
  "f holomorphic_on s \<Longrightarrow> (\<lambda>z. (f z)^n) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_power)

lemma holomorphic_on_setsum:
  "(\<And>i. i \<in> I \<Longrightarrow> (f i) holomorphic_on s) \<Longrightarrow> (\<lambda>x. setsum (\<lambda>i. f i x) I) holomorphic_on s"
  unfolding holomorphic_on_def by (metis complex_differentiable_setsum)

definition deriv :: "('a \<Rightarrow> 'a::real_normed_field) \<Rightarrow> 'a \<Rightarrow> 'a" where
  "deriv f x \<equiv> THE D. DERIV f x :> D"

lemma DERIV_imp_deriv: "DERIV f x :> f' \<Longrightarrow> deriv f x = f'"
  unfolding deriv_def by (metis the_equality DERIV_unique)

lemma DERIV_deriv_iff_real_differentiable:
  fixes x :: real
  shows "DERIV f x :> deriv f x \<longleftrightarrow> f differentiable at x"
  unfolding differentiable_def by (metis DERIV_imp_deriv has_real_derivative_iff)

lemma real_derivative_chain:
  fixes x :: real
  shows "f differentiable at x \<Longrightarrow> g differentiable at (f x)
    \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
  by (metis DERIV_deriv_iff_real_differentiable DERIV_chain DERIV_imp_deriv)

lemma DERIV_deriv_iff_complex_differentiable:
  "DERIV f x :> deriv f x \<longleftrightarrow> f complex_differentiable at x"
  unfolding complex_differentiable_def by (metis DERIV_imp_deriv)

lemma complex_derivative_chain:
  "f complex_differentiable at x \<Longrightarrow> g complex_differentiable at (f x)
    \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
  by (metis DERIV_deriv_iff_complex_differentiable DERIV_chain DERIV_imp_deriv)

lemma complex_derivative_linear: "deriv (\<lambda>w. c * w) = (\<lambda>z. c)"
  by (metis DERIV_imp_deriv DERIV_cmult_Id)

lemma complex_derivative_ident: "deriv (\<lambda>w. w) = (\<lambda>z. 1)"
  by (metis DERIV_imp_deriv DERIV_ident)

lemma complex_derivative_const: "deriv (\<lambda>w. c) = (\<lambda>z. 0)"
  by (metis DERIV_imp_deriv DERIV_const)

lemma complex_derivative_add:
  "\<lbrakk>f complex_differentiable at z; g complex_differentiable at z\<rbrakk>
   \<Longrightarrow> deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
  unfolding DERIV_deriv_iff_complex_differentiable[symmetric]
  by (auto intro!: DERIV_imp_deriv derivative_intros)

lemma complex_derivative_diff:
  "\<lbrakk>f complex_differentiable at z; g complex_differentiable at z\<rbrakk>
   \<Longrightarrow> deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
  unfolding DERIV_deriv_iff_complex_differentiable[symmetric]
  by (auto intro!: DERIV_imp_deriv derivative_intros)

lemma complex_derivative_mult:
  "\<lbrakk>f complex_differentiable at z; g complex_differentiable at z\<rbrakk>
   \<Longrightarrow> deriv (\<lambda>w. f w * g w) z = f z * deriv g z + deriv f z * g z"
  unfolding DERIV_deriv_iff_complex_differentiable[symmetric]
  by (auto intro!: DERIV_imp_deriv derivative_eq_intros)

lemma complex_derivative_cmult:
  "f complex_differentiable at z \<Longrightarrow> deriv (\<lambda>w. c * f w) z = c * deriv f z"
  unfolding DERIV_deriv_iff_complex_differentiable[symmetric]
  by (auto intro!: DERIV_imp_deriv derivative_eq_intros)

lemma complex_derivative_cmult_right:
  "f complex_differentiable at z \<Longrightarrow> deriv (\<lambda>w. f w * c) z = deriv f z * c"
  unfolding DERIV_deriv_iff_complex_differentiable[symmetric]
  by (auto intro!: DERIV_imp_deriv derivative_eq_intros)

lemma complex_derivative_transform_within_open:
  "\<lbrakk>f holomorphic_on s; g holomorphic_on s; open s; z \<in> s; \<And>w. w \<in> s \<Longrightarrow> f w = g w\<rbrakk>
   \<Longrightarrow> deriv f z = deriv g z"
  unfolding holomorphic_on_def
  by (rule DERIV_imp_deriv)
     (metis DERIV_deriv_iff_complex_differentiable DERIV_transform_within_open at_within_open)

lemma complex_derivative_compose_linear:
  "f complex_differentiable at (c * z) \<Longrightarrow> deriv (\<lambda>w. f (c * w)) z = c * deriv f (c * z)"
apply (rule DERIV_imp_deriv)
apply (simp add: DERIV_deriv_iff_complex_differentiable [symmetric])
apply (metis DERIV_chain' DERIV_cmult_Id comm_semiring_1_class.normalizing_semiring_rules(7))
done

subsection{*analyticity on a set*}

definition analytic_on (infixl "(analytic'_on)" 50)
  where
   "f analytic_on s \<equiv> \<forall>x \<in> s. \<exists>e. 0 < e \<and> f holomorphic_on (ball x e)"

lemma analytic_imp_holomorphic: "f analytic_on s \<Longrightarrow> f holomorphic_on s"
  by (simp add: at_within_open [OF _ open_ball] analytic_on_def holomorphic_on_def)
     (metis centre_in_ball complex_differentiable_at_within)

lemma analytic_on_open: "open s \<Longrightarrow> f analytic_on s \<longleftrightarrow> f holomorphic_on s"
apply (auto simp: analytic_imp_holomorphic)
apply (auto simp: analytic_on_def holomorphic_on_def)
by (metis holomorphic_on_def holomorphic_on_subset open_contains_ball)

lemma analytic_on_imp_differentiable_at:
  "f analytic_on s \<Longrightarrow> x \<in> s \<Longrightarrow> f complex_differentiable (at x)"
 apply (auto simp: analytic_on_def holomorphic_on_def)
by (metis Topology_Euclidean_Space.open_ball centre_in_ball complex_differentiable_within_open)

lemma analytic_on_subset: "f analytic_on s \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f analytic_on t"
  by (auto simp: analytic_on_def)

lemma analytic_on_Un: "f analytic_on (s \<union> t) \<longleftrightarrow> f analytic_on s \<and> f analytic_on t"
  by (auto simp: analytic_on_def)

lemma analytic_on_Union: "f analytic_on (\<Union> s) \<longleftrightarrow> (\<forall>t \<in> s. f analytic_on t)"
  by (auto simp: analytic_on_def)

lemma analytic_on_UN: "f analytic_on (\<Union>i\<in>I. s i) \<longleftrightarrow> (\<forall>i\<in>I. f analytic_on (s i))"
  by (auto simp: analytic_on_def)

lemma analytic_on_holomorphic:
  "f analytic_on s \<longleftrightarrow> (\<exists>t. open t \<and> s \<subseteq> t \<and> f holomorphic_on t)"
  (is "?lhs = ?rhs")
proof -
  have "?lhs \<longleftrightarrow> (\<exists>t. open t \<and> s \<subseteq> t \<and> f analytic_on t)"
  proof safe
    assume "f analytic_on s"
    then show "\<exists>t. open t \<and> s \<subseteq> t \<and> f analytic_on t"
      apply (simp add: analytic_on_def)
      apply (rule exI [where x="\<Union>{u. open u \<and> f analytic_on u}"], auto)
      apply (metis Topology_Euclidean_Space.open_ball analytic_on_open centre_in_ball)
      by (metis analytic_on_def)
  next
    fix t
    assume "open t" "s \<subseteq> t" "f analytic_on t"
    then show "f analytic_on s"
        by (metis analytic_on_subset)
  qed
  also have "... \<longleftrightarrow> ?rhs"
    by (auto simp: analytic_on_open)
  finally show ?thesis .
qed

lemma analytic_on_linear: "(op * c) analytic_on s"
  by (auto simp add: analytic_on_holomorphic holomorphic_on_linear)

lemma analytic_on_const: "(\<lambda>z. c) analytic_on s"
  by (metis analytic_on_def holomorphic_on_const zero_less_one)

lemma analytic_on_ident: "(\<lambda>x. x) analytic_on s"
  by (simp add: analytic_on_def holomorphic_on_ident gt_ex)

lemma analytic_on_id: "id analytic_on s"
  unfolding id_def by (rule analytic_on_ident)

lemma analytic_on_compose:
  assumes f: "f analytic_on s"
      and g: "g analytic_on (f ` s)"
    shows "(g o f) analytic_on s"
unfolding analytic_on_def
proof (intro ballI)
  fix x
  assume x: "x \<in> s"
  then obtain e where e: "0 < e" and fh: "f holomorphic_on ball x e" using f
    by (metis analytic_on_def)
  obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball (f x) e'" using g
    by (metis analytic_on_def g image_eqI x)
  have "isCont f x"
    by (metis analytic_on_imp_differentiable_at complex_differentiable_imp_continuous_at f x)
  with e' obtain d where d: "0 < d" and fd: "f ` ball x d \<subseteq> ball (f x) e'"
     by (auto simp: continuous_at_ball)
  have "g \<circ> f holomorphic_on ball x (min d e)"
    apply (rule holomorphic_on_compose)
    apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
    by (metis fd gh holomorphic_on_subset image_mono min.cobounded1 subset_ball)
  then show "\<exists>e>0. g \<circ> f holomorphic_on ball x e"
    by (metis d e min_less_iff_conj)
qed

lemma analytic_on_compose_gen:
  "f analytic_on s \<Longrightarrow> g analytic_on t \<Longrightarrow> (\<And>z. z \<in> s \<Longrightarrow> f z \<in> t)
             \<Longrightarrow> g o f analytic_on s"
by (metis analytic_on_compose analytic_on_subset image_subset_iff)

lemma analytic_on_neg:
  "f analytic_on s \<Longrightarrow> (\<lambda>z. -(f z)) analytic_on s"
by (metis analytic_on_holomorphic holomorphic_on_minus)

lemma analytic_on_add:
  assumes f: "f analytic_on s"
      and g: "g analytic_on s"
    shows "(\<lambda>z. f z + g z) analytic_on s"
unfolding analytic_on_def
proof (intro ballI)
  fix z
  assume z: "z \<in> s"
  then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
    by (metis analytic_on_def)
  obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
    by (metis analytic_on_def g z)
  have "(\<lambda>z. f z + g z) holomorphic_on ball z (min e e')"
    apply (rule holomorphic_on_add)
    apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
    by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
  then show "\<exists>e>0. (\<lambda>z. f z + g z) holomorphic_on ball z e"
    by (metis e e' min_less_iff_conj)
qed

lemma analytic_on_diff:
  assumes f: "f analytic_on s"
      and g: "g analytic_on s"
    shows "(\<lambda>z. f z - g z) analytic_on s"
unfolding analytic_on_def
proof (intro ballI)
  fix z
  assume z: "z \<in> s"
  then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
    by (metis analytic_on_def)
  obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
    by (metis analytic_on_def g z)
  have "(\<lambda>z. f z - g z) holomorphic_on ball z (min e e')"
    apply (rule holomorphic_on_diff)
    apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
    by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
  then show "\<exists>e>0. (\<lambda>z. f z - g z) holomorphic_on ball z e"
    by (metis e e' min_less_iff_conj)
qed

lemma analytic_on_mult:
  assumes f: "f analytic_on s"
      and g: "g analytic_on s"
    shows "(\<lambda>z. f z * g z) analytic_on s"
unfolding analytic_on_def
proof (intro ballI)
  fix z
  assume z: "z \<in> s"
  then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
    by (metis analytic_on_def)
  obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
    by (metis analytic_on_def g z)
  have "(\<lambda>z. f z * g z) holomorphic_on ball z (min e e')"
    apply (rule holomorphic_on_mult)
    apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
    by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
  then show "\<exists>e>0. (\<lambda>z. f z * g z) holomorphic_on ball z e"
    by (metis e e' min_less_iff_conj)
qed

lemma analytic_on_inverse:
  assumes f: "f analytic_on s"
      and nz: "(\<And>z. z \<in> s \<Longrightarrow> f z \<noteq> 0)"
    shows "(\<lambda>z. inverse (f z)) analytic_on s"
unfolding analytic_on_def
proof (intro ballI)
  fix z
  assume z: "z \<in> s"
  then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
    by (metis analytic_on_def)
  have "continuous_on (ball z e) f"
    by (metis fh holomorphic_on_imp_continuous_on)
  then obtain e' where e': "0 < e'" and nz': "\<And>y. dist z y < e' \<Longrightarrow> f y \<noteq> 0"
    by (metis Topology_Euclidean_Space.open_ball centre_in_ball continuous_on_open_avoid e z nz)
  have "(\<lambda>z. inverse (f z)) holomorphic_on ball z (min e e')"
    apply (rule holomorphic_on_inverse)
    apply (metis fh holomorphic_on_subset min.cobounded2 min.commute subset_ball)
    by (metis nz' mem_ball min_less_iff_conj)
  then show "\<exists>e>0. (\<lambda>z. inverse (f z)) holomorphic_on ball z e"
    by (metis e e' min_less_iff_conj)
qed

lemma analytic_on_divide:
  assumes f: "f analytic_on s"
      and g: "g analytic_on s"
      and nz: "(\<And>z. z \<in> s \<Longrightarrow> g z \<noteq> 0)"
    shows "(\<lambda>z. f z / g z) analytic_on s"
unfolding divide_inverse
by (metis analytic_on_inverse analytic_on_mult f g nz)

lemma analytic_on_power:
  "f analytic_on s \<Longrightarrow> (\<lambda>z. (f z) ^ n) analytic_on s"
by (induct n) (auto simp: analytic_on_const analytic_on_mult)

lemma analytic_on_setsum:
  "(\<And>i. i \<in> I \<Longrightarrow> (f i) analytic_on s) \<Longrightarrow> (\<lambda>x. setsum (\<lambda>i. f i x) I) analytic_on s"
  by (induct I rule: infinite_finite_induct) (auto simp: analytic_on_const analytic_on_add)

subsection{*analyticity at a point.*}

lemma analytic_at_ball:
  "f analytic_on {z} \<longleftrightarrow> (\<exists>e. 0<e \<and> f holomorphic_on ball z e)"
by (metis analytic_on_def singleton_iff)

lemma analytic_at:
    "f analytic_on {z} \<longleftrightarrow> (\<exists>s. open s \<and> z \<in> s \<and> f holomorphic_on s)"
by (metis analytic_on_holomorphic empty_subsetI insert_subset)

lemma analytic_on_analytic_at:
    "f analytic_on s \<longleftrightarrow> (\<forall>z \<in> s. f analytic_on {z})"
by (metis analytic_at_ball analytic_on_def)

lemma analytic_at_two:
  "f analytic_on {z} \<and> g analytic_on {z} \<longleftrightarrow>
   (\<exists>s. open s \<and> z \<in> s \<and> f holomorphic_on s \<and> g holomorphic_on s)"
  (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain s t
    where st: "open s" "z \<in> s" "f holomorphic_on s"
              "open t" "z \<in> t" "g holomorphic_on t"
    by (auto simp: analytic_at)
  show ?rhs
    apply (rule_tac x="s \<inter> t" in exI)
    using st
    apply (auto simp: Diff_subset holomorphic_on_subset)
    done
next
  assume ?rhs
  then show ?lhs
    by (force simp add: analytic_at)
qed

subsection{*Combining theorems for derivative with ``analytic at'' hypotheses*}

lemma
  assumes "f analytic_on {z}" "g analytic_on {z}"
  shows complex_derivative_add_at: "deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
    and complex_derivative_diff_at: "deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
    and complex_derivative_mult_at: "deriv (\<lambda>w. f w * g w) z =
           f z * deriv g z + deriv f z * g z"
proof -
  obtain s where s: "open s" "z \<in> s" "f holomorphic_on s" "g holomorphic_on s"
    using assms by (metis analytic_at_two)
  show "deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
    apply (rule DERIV_imp_deriv [OF DERIV_add])
    using s
    apply (auto simp: holomorphic_on_open complex_differentiable_def DERIV_deriv_iff_complex_differentiable)
    done
  show "deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
    apply (rule DERIV_imp_deriv [OF DERIV_diff])
    using s
    apply (auto simp: holomorphic_on_open complex_differentiable_def DERIV_deriv_iff_complex_differentiable)
    done
  show "deriv (\<lambda>w. f w * g w) z = f z * deriv g z + deriv f z * g z"
    apply (rule DERIV_imp_deriv [OF DERIV_mult'])
    using s
    apply (auto simp: holomorphic_on_open complex_differentiable_def DERIV_deriv_iff_complex_differentiable)
    done
qed

lemma complex_derivative_cmult_at:
  "f analytic_on {z} \<Longrightarrow>  deriv (\<lambda>w. c * f w) z = c * deriv f z"
by (auto simp: complex_derivative_mult_at complex_derivative_const analytic_on_const)

lemma complex_derivative_cmult_right_at:
  "f analytic_on {z} \<Longrightarrow>  deriv (\<lambda>w. f w * c) z = deriv f z * c"
by (auto simp: complex_derivative_mult_at complex_derivative_const analytic_on_const)

subsection{*Complex differentiation of sequences and series*}

lemma has_complex_derivative_sequence:
  fixes s :: "complex set"
  assumes cvs: "convex s"
      and df:  "\<And>n x. x \<in> s \<Longrightarrow> (f n has_field_derivative f' n x) (at x within s)"
      and conv: "\<And>e. 0 < e \<Longrightarrow> \<exists>N. \<forall>n x. n \<ge> N \<longrightarrow> x \<in> s \<longrightarrow> norm (f' n x - g' x) \<le> e"
      and "\<exists>x l. x \<in> s \<and> ((\<lambda>n. f n x) ---> l) sequentially"
    shows "\<exists>g. \<forall>x \<in> s. ((\<lambda>n. f n x) ---> g x) sequentially \<and>
                       (g has_field_derivative (g' x)) (at x within s)"
proof -
  from assms obtain x l where x: "x \<in> s" and tf: "((\<lambda>n. f n x) ---> l) sequentially"
    by blast
  { fix e::real assume e: "e > 0"
    then obtain N where N: "\<forall>n\<ge>N. \<forall>x. x \<in> s \<longrightarrow> cmod (f' n x - g' x) \<le> e"
      by (metis conv)
    have "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
    proof (rule exI [of _ N], clarify)
      fix n y h
      assume "N \<le> n" "y \<in> s"
      then have "cmod (f' n y - g' y) \<le> e"
        by (metis N)
      then have "cmod h * cmod (f' n y - g' y) \<le> cmod h * e"
        by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2)
      then show "cmod (f' n y * h - g' y * h) \<le> e * cmod h"
        by (simp add: norm_mult [symmetric] field_simps)
    qed
  } note ** = this
  show ?thesis
  unfolding has_field_derivative_def
  proof (rule has_derivative_sequence [OF cvs _ _ x])
    show "\<forall>n. \<forall>x\<in>s. (f n has_derivative (op * (f' n x))) (at x within s)"
      by (metis has_field_derivative_def df)
  next show "(\<lambda>n. f n x) ----> l"
    by (rule tf)
  next show "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
    by (blast intro: **)
  qed
qed

lemma has_complex_derivative_series:
  fixes s :: "complex set"
  assumes cvs: "convex s"
      and df:  "\<And>n x. x \<in> s \<Longrightarrow> (f n has_field_derivative f' n x) (at x within s)"
      and conv: "\<And>e. 0 < e \<Longrightarrow> \<exists>N. \<forall>n x. n \<ge> N \<longrightarrow> x \<in> s
                \<longrightarrow> cmod ((\<Sum>i<n. f' i x) - g' x) \<le> e"
      and "\<exists>x l. x \<in> s \<and> ((\<lambda>n. f n x) sums l)"
    shows "\<exists>g. \<forall>x \<in> s. ((\<lambda>n. f n x) sums g x) \<and> ((g has_field_derivative g' x) (at x within s))"
proof -
  from assms obtain x l where x: "x \<in> s" and sf: "((\<lambda>n. f n x) sums l)"
    by blast
  { fix e::real assume e: "e > 0"
    then obtain N where N: "\<forall>n x. n \<ge> N \<longrightarrow> x \<in> s
            \<longrightarrow> cmod ((\<Sum>i<n. f' i x) - g' x) \<le> e"
      by (metis conv)
    have "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
    proof (rule exI [of _ N], clarify)
      fix n y h
      assume "N \<le> n" "y \<in> s"
      then have "cmod ((\<Sum>i<n. f' i y) - g' y) \<le> e"
        by (metis N)
      then have "cmod h * cmod ((\<Sum>i<n. f' i y) - g' y) \<le> cmod h * e"
        by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2)
      then show "cmod ((\<Sum>i<n. h * f' i y) - g' y * h) \<le> e * cmod h"
        by (simp add: norm_mult [symmetric] field_simps setsum_right_distrib)
    qed
  } note ** = this
  show ?thesis
  unfolding has_field_derivative_def
  proof (rule has_derivative_series [OF cvs _ _ x])
    fix n x
    assume "x \<in> s"
    then show "((f n) has_derivative (\<lambda>z. z * f' n x)) (at x within s)"
      by (metis df has_field_derivative_def mult_commute_abs)
  next show " ((\<lambda>n. f n x) sums l)"
    by (rule sf)
  next show "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
    by (blast intro: **)
  qed
qed

subsection{*Bound theorem*}

lemma complex_differentiable_bound:
  fixes s :: "complex set"
  assumes cvs: "convex s"
      and df:  "\<And>z. z \<in> s \<Longrightarrow> (f has_field_derivative f' z) (at z within s)"
      and dn:  "\<And>z. z \<in> s \<Longrightarrow> norm (f' z) \<le> B"
      and "x \<in> s"  "y \<in> s"
    shows "norm(f x - f y) \<le> B * norm(x - y)"
  apply (rule differentiable_bound [OF cvs])
  apply (rule ballI, erule df [unfolded has_field_derivative_def])
  apply (rule ballI, rule onorm_le, simp add: norm_mult mult_right_mono dn)
  apply fact
  apply fact
  done

subsection{*Inverse function theorem for complex derivatives.*}

lemma has_complex_derivative_inverse_basic:
  fixes f :: "complex \<Rightarrow> complex"
  shows "DERIV f (g y) :> f' \<Longrightarrow>
        f' \<noteq> 0 \<Longrightarrow>
        continuous (at y) g \<Longrightarrow>
        open t \<Longrightarrow>
        y \<in> t \<Longrightarrow>
        (\<And>z. z \<in> t \<Longrightarrow> f (g z) = z)
        \<Longrightarrow> DERIV g y :> inverse (f')"
  unfolding has_field_derivative_def
  apply (rule has_derivative_inverse_basic)
  apply (auto simp:  bounded_linear_mult_right)
  done

(*Used only once, in Multivariate/cauchy.ml. *)
lemma has_complex_derivative_inverse_strong:
  fixes f :: "complex \<Rightarrow> complex"
  shows "DERIV f x :> f' \<Longrightarrow>
         f' \<noteq> 0 \<Longrightarrow>
         open s \<Longrightarrow>
         x \<in> s \<Longrightarrow>
         continuous_on s f \<Longrightarrow>
         (\<And>z. z \<in> s \<Longrightarrow> g (f z) = z)
         \<Longrightarrow> DERIV g (f x) :> inverse (f')"
  unfolding has_field_derivative_def
  apply (rule has_derivative_inverse_strong [of s x f g ])
  using assms
  by auto

lemma has_complex_derivative_inverse_strong_x:
  fixes f :: "complex \<Rightarrow> complex"
  shows  "DERIV f (g y) :> f' \<Longrightarrow>
          f' \<noteq> 0 \<Longrightarrow>
          open s \<Longrightarrow>
          continuous_on s f \<Longrightarrow>
          g y \<in> s \<Longrightarrow> f(g y) = y \<Longrightarrow>
          (\<And>z. z \<in> s \<Longrightarrow> g (f z) = z)
          \<Longrightarrow> DERIV g y :> inverse (f')"
  unfolding has_field_derivative_def
  apply (rule has_derivative_inverse_strong_x [of s g y f])
  using assms
  by auto

subsection {* Taylor on Complex Numbers *}

lemma setsum_Suc_reindex:
  fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
    shows  "setsum f {0..n} = f 0 - f (Suc n) + setsum (\<lambda>i. f (Suc i)) {0..n}"
by (induct n) auto

lemma complex_taylor:
  assumes s: "convex s"
      and f: "\<And>i x. x \<in> s \<Longrightarrow> i \<le> n \<Longrightarrow> (f i has_field_derivative f (Suc i) x) (at x within s)"
      and B: "\<And>x. x \<in> s \<Longrightarrow> cmod (f (Suc n) x) \<le> B"
      and w: "w \<in> s"
      and z: "z \<in> s"
    shows "cmod(f 0 z - (\<Sum>i\<le>n. f i w * (z-w) ^ i / of_nat (fact i)))
          \<le> B * cmod(z - w)^(Suc n) / fact n"
proof -
  have wzs: "closed_segment w z \<subseteq> s" using assms
    by (metis convex_contains_segment)
  { fix u
    assume "u \<in> closed_segment w z"
    then have "u \<in> s"
      by (metis wzs subsetD)
    have "(\<Sum>i\<le>n. f i u * (- of_nat i * (z-u)^(i - 1)) / of_nat (fact i) +
                      f (Suc i) u * (z-u)^i / of_nat (fact i)) =
              f (Suc n) u * (z-u) ^ n / of_nat (fact n)"
    proof (induction n)
      case 0 show ?case by simp
    next
      case (Suc n)
      have "(\<Sum>i\<le>Suc n. f i u * (- of_nat i * (z-u) ^ (i - 1)) / of_nat (fact i) +
                             f (Suc i) u * (z-u) ^ i / of_nat (fact i)) =
           f (Suc n) u * (z-u) ^ n / of_nat (fact n) +
           f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n) / of_nat (fact (Suc n)) -
           f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n) / of_nat (fact (Suc n))"
        using Suc by simp
      also have "... = f (Suc (Suc n)) u * (z-u) ^ Suc n / of_nat (fact (Suc n))"
      proof -
        have "of_nat(fact(Suc n)) *
             (f(Suc n) u *(z-u) ^ n / of_nat(fact n) +
               f(Suc(Suc n)) u *((z-u) *(z-u) ^ n) / of_nat(fact(Suc n)) -
               f(Suc n) u *((1 + of_nat n) *(z-u) ^ n) / of_nat(fact(Suc n))) =
            (of_nat(fact(Suc n)) *(f(Suc n) u *(z-u) ^ n)) / of_nat(fact n) +
            (of_nat(fact(Suc n)) *(f(Suc(Suc n)) u *((z-u) *(z-u) ^ n)) / of_nat(fact(Suc n))) -
            (of_nat(fact(Suc n)) *(f(Suc n) u *(of_nat(Suc n) *(z-u) ^ n))) / of_nat(fact(Suc n))"
          by (simp add: algebra_simps del: fact_Suc)
        also have "... =
                   (of_nat (fact (Suc n)) * (f (Suc n) u * (z-u) ^ n)) / of_nat (fact n) +
                   (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) -
                   (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))"
          by (simp del: fact_Suc)
        also have "... =
                   (of_nat (Suc n) * (f (Suc n) u * (z-u) ^ n)) +
                   (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) -
                   (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))"
          by (simp only: fact_Suc of_nat_mult ac_simps) simp
        also have "... = f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)"
          by (simp add: algebra_simps)
        finally show ?thesis
        by (simp add: mult_left_cancel [where c = "of_nat (fact (Suc n))", THEN iffD1] del: fact_Suc)
      qed
      finally show ?case .
    qed
    then have "((\<lambda>v. (\<Sum>i\<le>n. f i v * (z - v)^i / of_nat (fact i)))
                has_field_derivative f (Suc n) u * (z-u) ^ n / of_nat (fact n))
               (at u within s)"
      apply (intro derivative_eq_intros)
      apply (blast intro: assms `u \<in> s`)
      apply (rule refl)+
      apply (auto simp: field_simps)
      done
  } note sum_deriv = this
  { fix u
    assume u: "u \<in> closed_segment w z"
    then have us: "u \<in> s"
      by (metis wzs subsetD)
    have "cmod (f (Suc n) u) * cmod (z - u) ^ n \<le> cmod (f (Suc n) u) * cmod (u - z) ^ n"
      by (metis norm_minus_commute order_refl)
    also have "... \<le> cmod (f (Suc n) u) * cmod (z - w) ^ n"
      by (metis mult_left_mono norm_ge_zero power_mono segment_bound [OF u])
    also have "... \<le> B * cmod (z - w) ^ n"
      by (metis norm_ge_zero zero_le_power mult_right_mono  B [OF us])
    finally have "cmod (f (Suc n) u) * cmod (z - u) ^ n \<le> B * cmod (z - w) ^ n" .
  } note cmod_bound = this
  have "(\<Sum>i\<le>n. f i z * (z - z) ^ i / of_nat (fact i)) = (\<Sum>i\<le>n. (f i z / of_nat (fact i)) * 0 ^ i)"
    by simp
  also have "\<dots> = f 0 z / of_nat (fact 0)"
    by (subst setsum_zero_power) simp
  finally have "cmod (f 0 z - (\<Sum>i\<le>n. f i w * (z - w) ^ i / of_nat (fact i)))
            \<le> cmod ((\<Sum>i\<le>n. f i w * (z - w) ^ i / of_nat (fact i)) -
                    (\<Sum>i\<le>n. f i z * (z - z) ^ i / of_nat (fact i)))"
    by (simp add: norm_minus_commute)
  also have "... \<le> B * cmod (z - w) ^ n / real_of_nat (fact n) * cmod (w - z)"
    apply (rule complex_differentiable_bound
      [where f' = "\<lambda>w. f (Suc n) w * (z - w)^n / of_nat(fact n)"
         and s = "closed_segment w z", OF convex_segment])
    apply (auto simp: ends_in_segment real_of_nat_def DERIV_subset [OF sum_deriv wzs]
                  norm_divide norm_mult norm_power divide_le_cancel cmod_bound)
    done
  also have "...  \<le> B * cmod (z - w) ^ Suc n / real (fact n)"
    by (simp add: algebra_simps norm_minus_commute real_of_nat_def)
  finally show ?thesis .
qed

text{* Something more like the traditional MVT for real components.*}

lemma complex_mvt_line:
  assumes "\<And>u. u \<in> closed_segment w z \<Longrightarrow> (f has_field_derivative f'(u)) (at u)"
    shows "\<exists>u. u \<in> open_segment w z \<and> Re(f z) - Re(f w) = Re(f'(u) * (z - w))"
proof -
  have twz: "\<And>t. (1 - t) *\<^sub>R w + t *\<^sub>R z = w + t *\<^sub>R (z - w)"
    by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib)
  note assms[unfolded has_field_derivative_def, derivative_intros]
  show ?thesis
    apply (cut_tac mvt_simple
                     [of 0 1 "Re o f o (\<lambda>t. (1 - t) *\<^sub>R w +  t *\<^sub>R z)"
                      "\<lambda>u. Re o (\<lambda>h. f'((1 - u) *\<^sub>R w + u *\<^sub>R z) * h) o (\<lambda>t. t *\<^sub>R (z - w))"])
    apply auto
    apply (rule_tac x="(1 - x) *\<^sub>R w + x *\<^sub>R z" in exI)
    apply (auto simp add: open_segment_def twz) []
    apply (intro derivative_eq_intros has_derivative_at_within)
    apply simp_all
    apply (simp add: fun_eq_iff real_vector.scale_right_diff_distrib)
    apply (force simp add: twz closed_segment_def)
    done
qed

lemma complex_taylor_mvt:
  assumes "\<And>i x. \<lbrakk>x \<in> closed_segment w z; i \<le> n\<rbrakk> \<Longrightarrow> ((f i) has_field_derivative f (Suc i) x) (at x)"
    shows "\<exists>u. u \<in> closed_segment w z \<and>
            Re (f 0 z) =
            Re ((\<Sum>i = 0..n. f i w * (z - w) ^ i / of_nat (fact i)) +
                (f (Suc n) u * (z-u)^n / of_nat (fact n)) * (z - w))"
proof -
  { fix u
    assume u: "u \<in> closed_segment w z"
    have "(\<Sum>i = 0..n.
               (f (Suc i) u * (z-u) ^ i - of_nat i * (f i u * (z-u) ^ (i - Suc 0))) /
               of_nat (fact i)) =
          f (Suc 0) u -
             (f (Suc (Suc n)) u * ((z-u) ^ Suc n) - (of_nat (Suc n)) * (z-u) ^ n * f (Suc n) u) /
             of_nat (fact (Suc n)) +
             (\<Sum>i = 0..n.
                 (f (Suc (Suc i)) u * ((z-u) ^ Suc i) - of_nat (Suc i) * (f (Suc i) u * (z-u) ^ i)) /
                 of_nat (fact (Suc i)))"
       by (subst setsum_Suc_reindex) simp
    also have "... = f (Suc 0) u -
             (f (Suc (Suc n)) u * ((z-u) ^ Suc n) - (of_nat (Suc n)) * (z-u) ^ n * f (Suc n) u) /
             of_nat (fact (Suc n)) +
             (\<Sum>i = 0..n.
                 f (Suc (Suc i)) u * ((z-u) ^ Suc i) / of_nat (fact (Suc i))  -
                 f (Suc i) u * (z-u) ^ i / of_nat (fact i))"
      by (simp only: diff_divide_distrib fact_cancel ac_simps)
    also have "... = f (Suc 0) u -
             (f (Suc (Suc n)) u * (z-u) ^ Suc n - of_nat (Suc n) * (z-u) ^ n * f (Suc n) u) /
             of_nat (fact (Suc n)) +
             f (Suc (Suc n)) u * (z-u) ^ Suc n / of_nat (fact (Suc n)) - f (Suc 0) u"
      by (subst setsum_Suc_diff) auto
    also have "... = f (Suc n) u * (z-u) ^ n / of_nat (fact n)"
      by (simp only: algebra_simps diff_divide_distrib fact_cancel)
    finally have "(\<Sum>i = 0..n. (f (Suc i) u * (z - u) ^ i
                             - of_nat i * (f i u * (z-u) ^ (i - Suc 0))) / of_nat (fact i)) =
                  f (Suc n) u * (z - u) ^ n / of_nat (fact n)" .
    then have "((\<lambda>u. \<Sum>i = 0..n. f i u * (z - u) ^ i / of_nat (fact i)) has_field_derivative
                f (Suc n) u * (z - u) ^ n / of_nat (fact n))  (at u)"
      apply (intro derivative_eq_intros)+
      apply (force intro: u assms)
      apply (rule refl)+
      apply (auto simp: ac_simps)
      done
  }
  then show ?thesis
    apply (cut_tac complex_mvt_line [of w z "\<lambda>u. \<Sum>i = 0..n. f i u * (z-u) ^ i / of_nat (fact i)"
               "\<lambda>u. (f (Suc n) u * (z-u)^n / of_nat (fact n))"])
    apply (auto simp add: intro: open_closed_segment)
    done
qed

end


(*<*)
theory ABexpr imports Main begin
(*>*)

text{*
\index{datatypes!mutually recursive}%
Sometimes it is necessary to define two datatypes that depend on each
other. This is called \textbf{mutual recursion}. As an example consider a
language of arithmetic and boolean expressions where
\begin{itemize}
\item arithmetic expressions contain boolean expressions because there are
  conditional expressions like ``if $m<n$ then $n-m$ else $m-n$'',
  and
\item boolean expressions contain arithmetic expressions because of
  comparisons like ``$m<n$''.
\end{itemize}
In Isabelle this becomes
*}

datatype 'a aexp = IF   "'a bexp" "'a aexp" "'a aexp"
                 | Sum  "'a aexp" "'a aexp"
                 | Diff "'a aexp" "'a aexp"
                 | Var 'a
                 | Num nat
and      'a bexp = Less "'a aexp" "'a aexp"
                 | And  "'a bexp" "'a bexp"
                 | Neg  "'a bexp"

text{*\noindent
Type @{text"aexp"} is similar to @{text"expr"} in \S\ref{sec:ExprCompiler},
except that we have added an @{text IF} constructor,
fixed the values to be of type @{typ"nat"} and declared the two binary
operations @{text Sum} and @{term"Diff"}.  Boolean
expressions can be arithmetic comparisons, conjunctions and negations.
The semantics is given by two evaluation functions:
*}

primrec evala :: "'a aexp \<Rightarrow> ('a \<Rightarrow> nat) \<Rightarrow> nat" and
         evalb :: "'a bexp \<Rightarrow> ('a \<Rightarrow> nat) \<Rightarrow> bool" where
"evala (IF b a1 a2) env =
   (if evalb b env then evala a1 env else evala a2 env)" |
"evala (Sum a1 a2) env = evala a1 env + evala a2 env" |
"evala (Diff a1 a2) env = evala a1 env - evala a2 env" |
"evala (Var v) env = env v" |
"evala (Num n) env = n" |

"evalb (Less a1 a2) env = (evala a1 env < evala a2 env)" |
"evalb (And b1 b2) env = (evalb b1 env \<and> evalb b2 env)" |
"evalb (Neg b) env = (\<not> evalb b env)"

text{*\noindent

Both take an expression and an environment (a mapping from variables
@{typ"'a"} to values @{typ"nat"}) and return its arithmetic/boolean
value. Since the datatypes are mutually recursive, so are functions
that operate on them. Hence they need to be defined in a single
\isacommand{primrec} section. Notice the \isakeyword{and} separating
the declarations of @{const evala} and @{const evalb}. Their defining
equations need not be split into two groups;
the empty line is purely for readability.

In the same fashion we also define two functions that perform substitution:
*}

primrec substa :: "('a \<Rightarrow> 'b aexp) \<Rightarrow> 'a aexp \<Rightarrow> 'b aexp" and
         substb :: "('a \<Rightarrow> 'b aexp) \<Rightarrow> 'a bexp \<Rightarrow> 'b bexp" where
"substa s (IF b a1 a2) =
   IF (substb s b) (substa s a1) (substa s a2)" |
"substa s (Sum a1 a2) = Sum (substa s a1) (substa s a2)" |
"substa s (Diff a1 a2) = Diff (substa s a1) (substa s a2)" |
"substa s (Var v) = s v" |
"substa s (Num n) = Num n" |

"substb s (Less a1 a2) = Less (substa s a1) (substa s a2)" |
"substb s (And b1 b2) = And (substb s b1) (substb s b2)" |
"substb s (Neg b) = Neg (substb s b)"

text{*\noindent
Their first argument is a function mapping variables to expressions, the
substitution. It is applied to all variables in the second argument. As a
result, the type of variables in the expression may change from @{typ"'a"}
to @{typ"'b"}. Note that there are only arithmetic and no boolean variables.

Now we can prove a fundamental theorem about the interaction between
evaluation and substitution: applying a substitution $s$ to an expression $a$
and evaluating the result in an environment $env$ yields the same result as
evaluation $a$ in the environment that maps every variable $x$ to the value
of $s(x)$ under $env$. If you try to prove this separately for arithmetic or
boolean expressions (by induction), you find that you always need the other
theorem in the induction step. Therefore you need to state and prove both
theorems simultaneously:
*}

lemma "evala (substa s a) env = evala a (\<lambda>x. evala (s x) env) \<and>
        evalb (substb s b) env = evalb b (\<lambda>x. evala (s x) env)"
apply(induct_tac a and b)

txt{*\noindent The resulting 8 goals (one for each constructor) are proved in one fell swoop:
*}

apply simp_all
(*<*)done(*>*)

text{*
In general, given $n$ mutually recursive datatypes $\tau@1$, \dots, $\tau@n$,
an inductive proof expects a goal of the form
\[ P@1(x@1)\ \land \dots \land P@n(x@n) \]
where each variable $x@i$ is of type $\tau@i$. Induction is started by
\begin{isabelle}
\isacommand{apply}@{text"(induct_tac"} $x@1$ \isacommand{and} \dots\ \isacommand{and} $x@n$@{text ")"}
\end{isabelle}

\begin{exercise}
  Define a function @{text"norma"} of type @{typ"'a aexp => 'a aexp"} that
  replaces @{term"IF"}s with complex boolean conditions by nested
  @{term"IF"}s; it should eliminate the constructors
  @{term"And"} and @{term"Neg"}, leaving only @{term"Less"}.
  Prove that @{text"norma"}
  preserves the value of an expression and that the result of @{text"norma"}
  is really normal, i.e.\ no more @{term"And"}s and @{term"Neg"}s occur in
  it.  ({\em Hint:} proceed as in \S\ref{sec:boolex} and read the discussion
  of type annotations following lemma @{text subst_id} below).
\end{exercise}
*}
(*<*)
primrec norma :: "'a aexp \<Rightarrow> 'a aexp" and
        normb :: "'a bexp \<Rightarrow> 'a aexp \<Rightarrow> 'a aexp \<Rightarrow> 'a aexp" where
"norma (IF b t e)   = (normb b (norma t) (norma e))" |
"norma (Sum a1 a2)  = Sum (norma a1) (norma a2)" |
"norma (Diff a1 a2) = Diff (norma a1) (norma a2)" |
"norma (Var v)      = Var v" |
"norma (Num n)      = Num n" |

"normb (Less a1 a2) t e = IF (Less (norma a1) (norma a2)) t e" |
"normb (And b1 b2)  t e = normb b1 (normb b2 t e) e" |
"normb (Neg b)      t e = normb b e t"

lemma " evala (norma a) env = evala a env
      \<and> (\<forall> t e. evala (normb b t e) env = evala (IF b t e) env)"
apply (induct_tac a and b)
apply (simp_all)
done

primrec normala :: "'a aexp \<Rightarrow> bool" and
        normalb :: "'a bexp \<Rightarrow> bool" where
"normala (IF b t e)   = (normalb b \<and> normala t \<and> normala e)" |
"normala (Sum a1 a2)  = (normala a1 \<and> normala a2)" |
"normala (Diff a1 a2) = (normala a1 \<and> normala a2)" |
"normala (Var v)      = True" |
"normala (Num n)      = True" |

"normalb (Less a1 a2) = (normala a1 \<and> normala a2)" |
"normalb (And b1 b2)  = False" |
"normalb (Neg b)      = False"

lemma "normala (norma (a::'a aexp)) \<and>
       (\<forall> (t::'a aexp) e. (normala t \<and> normala e) \<longrightarrow> normala (normb b t e))"
apply (induct_tac a and b)
apply (auto)
done

end
(*>*)


theory TreeTravers
  imports Main
begin

  (*
    We define a new data type `'a tree` which is for binary tree,
    where both leafs and nodes have a value
  *)
  datatype 'a tree =
    Tip "'a"
    | Node "'a" "'a tree" "'a tree"

  (*
    We define a property called preOrder which takes a tree and
    returns a list with the value at the start.
  *)
  primrec preOrder :: "'a tree \<Rightarrow> 'a list"
    where
      "preOrder (Tip a)      = [a]"
    | "preOrder (Node f x y) = f#((preOrder x)@(preOrder y))"

  (*
    We define a property called postOrder which takes a tree and
    returns a list with the value at the end.
  *)
  primrec postOrder :: "'a tree \<Rightarrow> 'a list"
    where
      "postOrder (Tip a)      = [a]"
    | "postOrder (Node f x y) = (postOrder x)@(postOrder y)@[f]"

  (*
    We define a property called inOrder which takes a tree and
    returns a list with the value at the in location.
  *)
  primrec inOrder :: "'a tree \<Rightarrow> 'a list"
    where
      "inOrder (Tip a)      = [a]"
    | "inOrder (Node f x y) = (inOrder x)@[f]@(inOrder y)"

  (*
    We define a property called mirror which takes a tree and
    returns a tree with ever left leaf swapped with the right leaf.
  *)
  primrec mirror :: "'a tree \<Rightarrow> 'a tree"
    where
      "mirror (Tip a)      = (Tip a)"
    | "mirror (Node f x y) = (Node f (mirror y) (mirror x))"

  (*
    Now we will prove that by converting a tree in to a list and then reversing it is the same as
    mirroing a tree and then converting it into a list.
  *)

  (*
    We will do it for preOrder, we will apply induction tactic on the tree using auto
  *)
  theorem  "preOrder (mirror t) = rev (postOrder t)"
    apply (induct_tac t)
    apply auto
  done

  (*
    We will do it for postOrder, we will apply induction tactic on the tree using auto
  *)
  theorem "postOrder (mirror t) = rev (preOrder t)"
    apply (induct_tac t)
    apply auto
  done

  (*
    We will do it for inOrder, we will apply induction tactic on the tree using auto
  *)
  theorem "inOrder (mirror t) = rev (inOrder t)"
    apply (induct_tac t)
    apply auto
  done

end


section "Vertex Cover"

theory Approx_VC_Hoare
imports "HOL-Hoare.Hoare_Logic"
begin

text \<open>The algorithm is classical, the proof is based on and augments the one
by Berghammer and M\"uller-Olm \cite{BerghammerM03}.\<close>

subsection "Graph"

text \<open>A graph is simply a set of edges, where an edge is a 2-element set.\<close>

definition vertex_cover :: "'a set set \<Rightarrow> 'a set \<Rightarrow> bool" where
"vertex_cover E C = (\<forall>e \<in> E. e \<inter> C \<noteq> {})"

abbreviation matching :: "'a set set \<Rightarrow> bool" where
"matching M \<equiv> pairwise disjnt M"

lemma card_matching_vertex_cover:
  "\<lbrakk> finite C;  matching M;  M \<subseteq> E;  vertex_cover E C \<rbrakk> \<Longrightarrow> card M \<le> card C"
apply(erule card_le_if_inj_on_rel[where r = "\<lambda>e v. v \<in> e"])
 apply (meson disjnt_def disjnt_iff vertex_cover_def subsetCE)
by (meson disjnt_iff pairwise_def)

subsection "The Approximation Algorithm"

text \<open>Formulated using a simple(!) predefined Hoare-logic.
This leads to a streamlined proof based on standard invariant reasoning.

The nondeterministic selection of an element from a set \<open>F\<close> is simulated by @{term "SOME x. x \<in> F"}.
The \<open>SOME\<close> operator is built into HOL: @{term "SOME x. P x"} denotes some \<open>x\<close> that satisfies \<open>P\<close>
if such an \<open>x\<close> exists; otherwise it denotes an arbitrary element. Note that there is no
actual nondeterminism involved: @{term "SOME x. P x"} is some fixed element
but in general we don't know which one. Proofs about \<open>SOME\<close> are notoriously tedious.
Typically it involves showing first that @{prop "\<exists>x. P x"}. Then @{thm someI_ex} implies
@{prop"P (SOME x. P x)"}. There are a number of (more) useful related theorems:
just click on @{thm someI_ex} to be taken there.\<close>

text \<open>Convenient notation for choosing an arbitrary element from a set:\<close>
abbreviation "some A \<equiv> SOME x. x \<in> A"

locale Edges =
  fixes E :: "'a set set"
  assumes finE: "finite E"
  assumes edges2: "e \<in> E \<Longrightarrow> card e = 2"
begin

text \<open>The invariant:\<close>

definition "inv_matching C F M =
  (matching M \<and> M \<subseteq> E \<and> card C \<le> 2 * card M \<and> (\<forall>e \<in> M. \<forall>f \<in> F. e \<inter> f = {}))"

definition invar :: "'a set \<Rightarrow> 'a set set \<Rightarrow> bool" where
"invar C F = (F \<subseteq> E \<and> vertex_cover (E-F) C \<and> finite C \<and> (\<exists>M. inv_matching C F M))"

text \<open>Preservation of the invariant by the loop body:\<close>

lemma approx_vertex_cover:
"VARS C F
  {True}
  C := {};
  F := E;
  WHILE F \<noteq> {}
  INV {invar C F}
  DO C := C \<union> some F;
     F := F - {e' \<in> F. some F \<inter> e' \<noteq> {}}
  OD
  {vertex_cover E C \<and> (\<forall>C'. finite C' \<and> vertex_cover E C' \<longrightarrow> card C \<le> 2 * card C')}"
proof (vcg, goal_cases)
  case (1 C F)
  have "inv_matching {} E {}" by (auto simp add: inv_matching_def)
  with 1 show ?case by (auto simp add: invar_def vertex_cover_def)
next
  case (2 C F)
  thus ?case using invar_step[of F C] by(auto simp: Let_def)
next
  case (3 C F)
  then obtain M :: "'a set set" where
    post: "vertex_cover E C" "matching M" "M \<subseteq> E" "card C \<le> 2 * card M"
    by(auto simp: invar_def inv_matching_def)

  have opt: "card C \<le> 2 * card C'" if C': "finite C'" "vertex_cover E C'" for C'
  proof -
    note post(4)
    also have "2 * card M \<le> 2 * card C'"
    using card_matching_vertex_cover[OF C'(1) post(2,3) C'(2)] by simp
    finally show "card C \<le> 2 * card C'" .
  qed

  show ?case using post(1) opt by auto
qed

end (* locale Graph *)

subsection "Version for Hypergraphs"

text \<open>Almost the same. We assume that the degree of every edge is bounded.\<close>

locale Bounded_Hypergraph =
  fixes E :: "'a set set"
  fixes k :: nat
  assumes finE: "finite E"
  assumes edge_bnd: "e \<in> E \<Longrightarrow> finite e \<and> card e \<le> k"
  assumes E1: "{} \<notin> E"
begin

definition "inv_matching C F M =
  (matching M \<and> M \<subseteq> E \<and> card C \<le> k * card M \<and> (\<forall>e \<in> M. \<forall>f \<in> F. e \<inter> f = {}))"

definition invar :: "'a set \<Rightarrow> 'a set set \<Rightarrow> bool" where
"invar C F = (F \<subseteq> E \<and> vertex_cover (E-F) C \<and> finite C \<and> (\<exists>M. inv_matching C F M))"

lemma invar_step:
  assumes "F \<noteq> {}" "invar C F"
  shows "invar (C \<union> some F) (F - {e' \<in> F. some F \<inter> e' \<noteq> {}})"
proof -
  from assms(2) obtain M where "F \<subseteq> E" and vc: "vertex_cover (E-F) C" and fC: "finite C"
    and m: "matching M" "M \<subseteq> E" and card: "card C \<le> k * card M"
    and disj: "\<forall>e \<in> M. \<forall>f \<in> F. e \<inter> f = {}"
  by (auto simp: invar_def inv_matching_def)
  let ?e = "SOME e. e \<in> F"
  have "?e \<in> F" using \<open>F \<noteq> {}\<close> by (simp add: some_in_eq)
  hence fe': "finite ?e" using \<open>F \<subseteq> E\<close> assms(2) edge_bnd by blast
  have "?e \<notin> M" using E1 \<open>?e \<in> F\<close> disj \<open>F \<subseteq> E\<close> by fastforce
  have card': "card (C \<union> ?e) \<le> k * card (insert ?e M)"
    using \<open>?e \<in> F\<close> \<open>?e \<notin> M\<close> card_Un_le[of C ?e] \<open>F \<subseteq> E\<close> edge_bnd card finite_subset[OF m(2) finE]
    by fastforce
  let ?M = "M \<union> {?e}"
  have vc': "vertex_cover (E - (F - {e' \<in> F. ?e \<inter> e' \<noteq> {}})) (C \<union> ?e)"
    using vc by(auto simp: vertex_cover_def)
  have m': "inv_matching (C \<union> ?e) (F - {e' \<in> F. ?e \<inter> e' \<noteq> {}}) ?M"
    using m card' \<open>F \<subseteq> E\<close> \<open>?e \<in> F\<close> disj
    by(auto simp: inv_matching_def Int_commute disjnt_def pairwise_insert)
  show ?thesis using \<open>F \<subseteq> E\<close> vc' fC fe' m' by(auto simp add: invar_def Let_def)
qed

lemma approx_vertex_cover_bnd:
"VARS C F
  {True}
  C := {};
  F := E;
  WHILE F \<noteq> {}
  INV {invar C F}
  DO C := C \<union> some F;
     F := F - {e' \<in> F. some F \<inter> e' \<noteq> {}}
  OD
  {vertex_cover E C \<and> (\<forall>C'. finite C' \<and> vertex_cover E C' \<longrightarrow> card C \<le> k * card C')}"
proof (vcg, goal_cases)
  case (1 C F)
  have "inv_matching {} E {}" by (auto simp add: inv_matching_def)
  with 1 show ?case by (auto simp add: invar_def vertex_cover_def)
next
  case (2 C F)
  thus ?case using invar_step[of F C] by(auto simp: Let_def)
next
  case (3 C F)
  then obtain M :: "'a set set" where
    post: "vertex_cover E C" "matching M" "M \<subseteq> E" "card C \<le> k * card M"
    by(auto simp: invar_def inv_matching_def)

  have opt: "card C \<le> k * card C'" if C': "finite C'" "vertex_cover E C'" for C'
  proof -
    note post(4)
    also have "k * card M \<le> k * card C'"
    using card_matching_vertex_cover[OF C'(1) post(2,3) C'(2)] by simp
    finally show "card C \<le> k * card C'" .
  qed

  show ?case using post(1) opt by auto
qed

end (* locale Bounded_Hypergraph *)

end