(*  Title:      HOL/Decision_Procs/Polynomial_List.thy
    Author:     Amine Chaieb
*)

section {* Univariate Polynomials as lists *}

theory Polynomial_List
imports Complex_Main
begin

text{* Application of polynomial as a function. *}

primrec (in semiring_0) poly :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a"
where
  poly_Nil:  "poly [] x = 0"
| poly_Cons: "poly (h#t) x = h + x * poly t x"

subsection{*Arithmetic Operations on Polynomials*}

text{*addition*}

primrec (in semiring_0) padd :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixl "+++" 65)
where
  padd_Nil:  "[] +++ l2 = l2"
| padd_Cons: "(h#t) +++ l2 = (if l2 = [] then h#t else (h + hd l2)#(t +++ tl l2))"

text{*Multiplication by a constant*}
primrec (in semiring_0) cmult :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixl "%*" 70) where
  cmult_Nil:  "c %* [] = []"
| cmult_Cons: "c %* (h#t) = (c * h)#(c %* t)"

text{*Multiplication by a polynomial*}
primrec (in semiring_0) pmult :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixl "***" 70)
where
  pmult_Nil:  "[] *** l2 = []"
| pmult_Cons: "(h#t) *** l2 = (if t = [] then h %* l2
                              else (h %* l2) +++ ((0) # (t *** l2)))"

text{*Repeated multiplication by a polynomial*}
primrec (in semiring_0) mulexp :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a  list \<Rightarrow> 'a list" where
  mulexp_zero:  "mulexp 0 p q = q"
| mulexp_Suc:   "mulexp (Suc n) p q = p *** mulexp n p q"

text{*Exponential*}
primrec (in semiring_1) pexp :: "'a list \<Rightarrow> nat \<Rightarrow> 'a list"  (infixl "%^" 80) where
  pexp_0:   "p %^ 0 = [1]"
| pexp_Suc: "p %^ (Suc n) = p *** (p %^ n)"

text{*Quotient related value of dividing a polynomial by x + a*}
(* Useful for divisor properties in inductive proofs *)
primrec (in field) "pquot" :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
where
  pquot_Nil:  "pquot [] a= []"
| pquot_Cons: "pquot (h#t) a =
    (if t = [] then [h] else (inverse(a) * (h - hd( pquot t a)))#(pquot t a))"

text{*normalization of polynomials (remove extra 0 coeff)*}
primrec (in semiring_0) pnormalize :: "'a list \<Rightarrow> 'a list" where
  pnormalize_Nil:  "pnormalize [] = []"
| pnormalize_Cons: "pnormalize (h#p) =
    (if pnormalize p = [] then (if h = 0 then [] else [h]) else h # pnormalize p)"

definition (in semiring_0) "pnormal p = ((pnormalize p = p) \<and> p \<noteq> [])"
definition (in semiring_0) "nonconstant p = (pnormal p \<and> (\<forall>x. p \<noteq> [x]))"
text{*Other definitions*}

definition (in ring_1) poly_minus :: "'a list \<Rightarrow> 'a list" ("-- _" [80] 80)
  where "-- p = (- 1) %* p"

definition (in semiring_0) divides :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool"  (infixl "divides" 70)
  where "p1 divides p2 = (\<exists>q. poly p2 = poly(p1 *** q))"

lemma (in semiring_0) dividesI:
  "poly p2 = poly (p1 *** q) \<Longrightarrow> p1 divides p2"
  by (auto simp add: divides_def)

lemma (in semiring_0) dividesE:
  assumes "p1 divides p2"
  obtains q where "poly p2 = poly (p1 *** q)"
  using assms by (auto simp add: divides_def)

    --{*order of a polynomial*}
definition (in ring_1) order :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
  "order a p = (SOME n. ([-a, 1] %^ n) divides p \<and> ~ (([-a, 1] %^ (Suc n)) divides p))"

     --{*degree of a polynomial*}
definition (in semiring_0) degree :: "'a list \<Rightarrow> nat"
  where "degree p = length (pnormalize p) - 1"

     --{*squarefree polynomials --- NB with respect to real roots only.*}
definition (in ring_1) rsquarefree :: "'a list \<Rightarrow> bool"
  where "rsquarefree p \<longleftrightarrow> poly p \<noteq> poly [] \<and> (\<forall>a. order a p = 0 \<or> order a p = 1)"

context semiring_0
begin

lemma padd_Nil2[simp]: "p +++ [] = p"
  by (induct p) auto

lemma padd_Cons_Cons: "(h1 # p1) +++ (h2 # p2) = (h1 + h2) # (p1 +++ p2)"
  by auto

lemma pminus_Nil: "-- [] = []"
  by (simp add: poly_minus_def)

lemma pmult_singleton: "[h1] *** p1 = h1 %* p1" by simp

end

lemma (in semiring_1) poly_ident_mult[simp]: "1 %* t = t" by (induct t) auto

lemma (in semiring_0) poly_simple_add_Cons[simp]: "[a] +++ ((0)#t) = (a#t)"
  by simp

text{*Handy general properties*}

lemma (in comm_semiring_0) padd_commut: "b +++ a = a +++ b"
proof (induct b arbitrary: a)
  case Nil
  thus ?case by auto
next
  case (Cons b bs a)
  thus ?case by (cases a) (simp_all add: add.commute)
qed

lemma (in comm_semiring_0) padd_assoc: "\<forall>b c. (a +++ b) +++ c = a +++ (b +++ c)"
  apply (induct a)
  apply (simp, clarify)
  apply (case_tac b, simp_all add: ac_simps)
  done

lemma (in semiring_0) poly_cmult_distr: "a %* ( p +++ q) = (a %* p +++ a %* q)"
  apply (induct p arbitrary: q)
  apply simp
  apply (case_tac q, simp_all add: distrib_left)
  done

lemma (in ring_1) pmult_by_x[simp]: "[0, 1] *** t = ((0)#t)"
  apply (induct t)
  apply simp
  apply (auto simp add: padd_commut)
  apply (case_tac t, auto)
  done

text{*properties of evaluation of polynomials.*}

lemma (in semiring_0) poly_add: "poly (p1 +++ p2) x = poly p1 x + poly p2 x"
proof(induct p1 arbitrary: p2)
  case Nil
  thus ?case by simp
next
  case (Cons a as p2)
  thus ?case
    by (cases p2) (simp_all  add: ac_simps distrib_left)
qed

lemma (in comm_semiring_0) poly_cmult: "poly (c %* p) x = c * poly p x"
  apply (induct p)
  apply (case_tac [2] "x = zero")
  apply (auto simp add: distrib_left ac_simps)
  done

lemma (in comm_semiring_0) poly_cmult_map: "poly (map (op * c) p) x = c*poly p x"
  by (induct p) (auto simp add: distrib_left ac_simps)

lemma (in comm_ring_1) poly_minus: "poly (-- p) x = - (poly p x)"
  apply (simp add: poly_minus_def)
  apply (auto simp add: poly_cmult)
  done

lemma (in comm_semiring_0) poly_mult: "poly (p1 *** p2) x = poly p1 x * poly p2 x"
proof (induct p1 arbitrary: p2)
  case Nil
  thus ?case by simp
next
  case (Cons a as p2)
  thus ?case by (cases as)
    (simp_all add: poly_cmult poly_add distrib_right distrib_left ac_simps)
qed

class idom_char_0 = idom + ring_char_0

subclass (in field_char_0) idom_char_0 ..

lemma (in comm_ring_1) poly_exp: "poly (p %^ n) x = (poly p x) ^ n"
  by (induct n) (auto simp add: poly_cmult poly_mult)

text{*More Polynomial Evaluation Lemmas*}

lemma (in semiring_0) poly_add_rzero[simp]: "poly (a +++ []) x = poly a x"
  by simp

lemma (in comm_semiring_0) poly_mult_assoc: "poly ((a *** b) *** c) x = poly (a *** (b *** c)) x"
  by (simp add: poly_mult mult.assoc)

lemma (in semiring_0) poly_mult_Nil2[simp]: "poly (p *** []) x = 0"
  by (induct p) auto

lemma (in comm_semiring_1) poly_exp_add: "poly (p %^ (n + d)) x = poly( p %^ n *** p %^ d) x"
  by (induct n) (auto simp add: poly_mult mult.assoc)

subsection{*Key Property: if @{term "f(a) = 0"} then @{term "(x - a)"} divides
 @{term "p(x)"} *}

lemma (in comm_ring_1) lemma_poly_linear_rem: "\<forall>h. \<exists>q r. h#t = [r] +++ [-a, 1] *** q"
proof(induct t)
  case Nil
  { fix h have "[h] = [h] +++ [- a, 1] *** []" by simp }
  thus ?case by blast
next
  case (Cons  x xs)
  { fix h
    from Cons.hyps[rule_format, of x]
    obtain q r where qr: "x#xs = [r] +++ [- a, 1] *** q" by blast
    have "h#x#xs = [a*r + h] +++ [-a, 1] *** (r#q)"
      using qr by (cases q) (simp_all add: algebra_simps)
    hence "\<exists>q r. h#x#xs = [r] +++ [-a, 1] *** q" by blast}
  thus ?case by blast
qed

lemma (in comm_ring_1) poly_linear_rem: "\<exists>q r. h#t = [r] +++ [-a, 1] *** q"
  using lemma_poly_linear_rem [where t = t and a = a] by auto

lemma (in comm_ring_1) poly_linear_divides: "(poly p a = 0) = ((p = []) | (\<exists>q. p = [-a, 1] *** q))"
proof -
  { assume p: "p = []" hence ?thesis by simp }
  moreover
  {
    fix x xs assume p: "p = x#xs"
    {
      fix q assume "p = [-a, 1] *** q"
      hence "poly p a = 0" by (simp add: poly_add poly_cmult)
    }
    moreover
    { assume p0: "poly p a = 0"
      from poly_linear_rem[of x xs a] obtain q r
      where qr: "x#xs = [r] +++ [- a, 1] *** q" by blast
      have "r = 0" using p0 by (simp only: p qr poly_mult poly_add) simp
      hence "\<exists>q. p = [- a, 1] *** q"
        using p qr
        apply -
        apply (rule exI[where x=q])
        apply auto
        apply (cases q)
        apply auto
        done
    }
    ultimately have ?thesis using p by blast
  }
  ultimately show ?thesis by (cases p) auto
qed

lemma (in semiring_0) lemma_poly_length_mult[simp]: "\<forall>h k a. length (k %* p +++  (h # (a %* p))) = Suc (length p)"
  by (induct p) auto

lemma (in semiring_0) lemma_poly_length_mult2[simp]: "\<forall>h k. length (k %* p +++  (h # p)) = Suc (length p)"
  by (induct p) auto

lemma (in ring_1) poly_length_mult[simp]: "length([-a,1] *** q) = Suc (length q)"
  by auto

subsection{*Polynomial length*}

lemma (in semiring_0) poly_cmult_length[simp]: "length (a %* p) = length p"
  by (induct p) auto

lemma (in semiring_0) poly_add_length: "length (p1 +++ p2) = max (length p1) (length p2)"
  by (induct p1 arbitrary: p2) (simp_all, arith)

lemma (in semiring_0) poly_root_mult_length[simp]: "length([a,b] *** p) = Suc (length p)"
  by (simp add: poly_add_length)

lemma (in idom) poly_mult_not_eq_poly_Nil[simp]:
  "poly (p *** q) x \<noteq> poly [] x \<longleftrightarrow> poly p x \<noteq> poly [] x \<and> poly q x \<noteq> poly [] x"
  by (auto simp add: poly_mult)

lemma (in idom) poly_mult_eq_zero_disj: "poly (p *** q) x = 0 \<longleftrightarrow> poly p x = 0 \<or> poly q x = 0"
  by (auto simp add: poly_mult)

text{*Normalisation Properties*}

lemma (in semiring_0) poly_normalized_nil: "(pnormalize p = []) --> (poly p x = 0)"
  by (induct p) auto

text{*A nontrivial polynomial of degree n has no more than n roots*}
lemma (in idom) poly_roots_index_lemma:
   assumes p: "poly p x \<noteq> poly [] x" and n: "length p = n"
  shows "\<exists>i. \<forall>x. poly p x = 0 \<longrightarrow> (\<exists>m\<le>n. x = i m)"
  using p n
proof (induct n arbitrary: p x)
  case 0
  thus ?case by simp
next
  case (Suc n p x)
  {
    assume C: "\<And>i. \<exists>x. poly p x = 0 \<and> (\<forall>m\<le>Suc n. x \<noteq> i m)"
    from Suc.prems have p0: "poly p x \<noteq> 0" "p\<noteq> []" by auto
    from p0(1)[unfolded poly_linear_divides[of p x]]
    have "\<forall>q. p \<noteq> [- x, 1] *** q" by blast
    from C obtain a where a: "poly p a = 0" by blast
    from a[unfolded poly_linear_divides[of p a]] p0(2)
    obtain q where q: "p = [-a, 1] *** q" by blast
    have lg: "length q = n" using q Suc.prems(2) by simp
    from q p0 have qx: "poly q x \<noteq> poly [] x"
      by (auto simp add: poly_mult poly_add poly_cmult)
    from Suc.hyps[OF qx lg] obtain i where
      i: "\<forall>x. poly q x = 0 \<longrightarrow> (\<exists>m\<le>n. x = i m)" by blast
    let ?i = "\<lambda>m. if m = Suc n then a else i m"
    from C[of ?i] obtain y where y: "poly p y = 0" "\<forall>m\<le> Suc n. y \<noteq> ?i m"
      by blast
    from y have "y = a \<or> poly q y = 0"
      by (simp only: q poly_mult_eq_zero_disj poly_add) (simp add: algebra_simps)
    with i[rule_format, of y] y(1) y(2) have False
      apply auto
      apply (erule_tac x = "m" in allE)
      apply auto
      done
  }
  thus ?case by blast
qed

lemma (in idom) poly_roots_index_length:
  "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>i. \<forall>x. (poly p x = 0) \<longrightarrow> (\<exists>n. n \<le> length p \<and> x = i n)"
  by (blast intro: poly_roots_index_lemma)

lemma (in idom) poly_roots_finite_lemma1:
  "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>N i. \<forall>x. (poly p x = 0) \<longrightarrow> (\<exists>n. (n::nat) < N \<and> x = i n)"
  apply (drule poly_roots_index_length, safe)
  apply (rule_tac x = "Suc (length p)" in exI)
  apply (rule_tac x = i in exI)
  apply (simp add: less_Suc_eq_le)
  done

lemma (in idom) idom_finite_lemma:
  assumes P: "\<forall>x. P x --> (\<exists>n. n < length j \<and> x = j!n)"
  shows "finite {x. P x}"
proof -
  let ?M = "{x. P x}"
  let ?N = "set j"
  have "?M \<subseteq> ?N" using P by auto
  thus ?thesis using finite_subset by auto
qed

lemma (in idom) poly_roots_finite_lemma2:
  "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>i. \<forall>x. poly p x = 0 \<longrightarrow> x \<in> set i"
  apply (drule poly_roots_index_length, safe)
  apply (rule_tac x="map (\<lambda>n. i n) [0 ..< Suc (length p)]" in exI)
  apply (auto simp add: image_iff)
  apply (erule_tac x="x" in allE, clarsimp)
  apply (case_tac "n = length p")
  apply (auto simp add: order_le_less)
  done

lemma (in ring_char_0) UNIV_ring_char_0_infinte: "\<not> (finite (UNIV:: 'a set))"
proof
  assume F: "finite (UNIV :: 'a set)"
  have "finite (UNIV :: nat set)"
  proof (rule finite_imageD)
    have "of_nat ` UNIV \<subseteq> UNIV" by simp
    then show "finite (of_nat ` UNIV :: 'a set)" using F by (rule finite_subset)
    show "inj (of_nat :: nat \<Rightarrow> 'a)" by (simp add: inj_on_def)
  qed
  with infinite_UNIV_nat show False ..
qed

lemma (in idom_char_0) poly_roots_finite: "poly p \<noteq> poly [] \<longleftrightarrow> finite {x. poly p x = 0}"
proof
  assume H: "poly p \<noteq> poly []"
  show "finite {x. poly p x = (0::'a)}"
    using H
    apply -
    apply (erule contrapos_np, rule ext)
    apply (rule ccontr)
    apply (clarify dest!: poly_roots_finite_lemma2)
    using finite_subset
  proof -
    fix x i
    assume F: "\<not> finite {x. poly p x = (0\<Colon>'a)}"
      and P: "\<forall>x. poly p x = (0\<Colon>'a) \<longrightarrow> x \<in> set i"
    let ?M= "{x. poly p x = (0\<Colon>'a)}"
    from P have "?M \<subseteq> set i" by auto
    with finite_subset F show False by auto
  qed
next
  assume F: "finite {x. poly p x = (0\<Colon>'a)}"
  show "poly p \<noteq> poly []" using F UNIV_ring_char_0_infinte by auto
qed

text{*Entirety and Cancellation for polynomials*}

lemma (in idom_char_0) poly_entire_lemma2:
  assumes p0: "poly p \<noteq> poly []"
    and q0: "poly q \<noteq> poly []"
  shows "poly (p***q) \<noteq> poly []"
proof -
  let ?S = "\<lambda>p. {x. poly p x = 0}"
  have "?S (p *** q) = ?S p \<union> ?S q" by (auto simp add: poly_mult)
  with p0 q0 show ?thesis  unfolding poly_roots_finite by auto
qed

lemma (in idom_char_0) poly_entire:
  "poly (p *** q) = poly [] \<longleftrightarrow> poly p = poly [] \<or> poly q = poly []"
  using poly_entire_lemma2[of p q]
  by (auto simp add: fun_eq_iff poly_mult)

lemma (in idom_char_0) poly_entire_neg:
  "poly (p *** q) \<noteq> poly [] \<longleftrightarrow> poly p \<noteq> poly [] \<and> poly q \<noteq> poly []"
  by (simp add: poly_entire)

lemma fun_eq: "f = g \<longleftrightarrow> (\<forall>x. f x = g x)"
  by auto

lemma (in comm_ring_1) poly_add_minus_zero_iff:
  "poly (p +++ -- q) = poly [] \<longleftrightarrow> poly p = poly q"
  by (auto simp add: algebra_simps poly_add poly_minus_def fun_eq poly_cmult)

lemma (in comm_ring_1) poly_add_minus_mult_eq:
  "poly (p *** q +++ --(p *** r)) = poly (p *** (q +++ -- r))"
  by (auto simp add: poly_add poly_minus_def fun_eq poly_mult poly_cmult algebra_simps)

subclass (in idom_char_0) comm_ring_1 ..

lemma (in idom_char_0) poly_mult_left_cancel:
  "poly (p *** q) = poly (p *** r) \<longleftrightarrow> poly p = poly [] \<or> poly q = poly r"
proof -
  have "poly (p *** q) = poly (p *** r) \<longleftrightarrow> poly (p *** q +++ -- (p *** r)) = poly []"
    by (simp only: poly_add_minus_zero_iff)
  also have "\<dots> \<longleftrightarrow> poly p = poly [] \<or> poly q = poly r"
    by (auto intro: simp add: poly_add_minus_mult_eq poly_entire poly_add_minus_zero_iff)
  finally show ?thesis .
qed

lemma (in idom) poly_exp_eq_zero[simp]:
  "poly (p %^ n) = poly [] \<longleftrightarrow> poly p = poly [] \<and> n \<noteq> 0"
  apply (simp only: fun_eq add: HOL.all_simps [symmetric])
  apply (rule arg_cong [where f = All])
  apply (rule ext)
  apply (induct n)
  apply (auto simp add: poly_exp poly_mult)
  done

lemma (in comm_ring_1) poly_prime_eq_zero[simp]: "poly [a,1] \<noteq> poly []"
  apply (simp add: fun_eq)
  apply (rule_tac x = "minus one a" in exI)
  apply (simp add: add.commute [of a])
  done

lemma (in idom) poly_exp_prime_eq_zero: "poly ([a, 1] %^ n) \<noteq> poly []"
  by auto

text{*A more constructive notion of polynomials being trivial*}

lemma (in idom_char_0) poly_zero_lemma': "poly (h # t) = poly [] \<Longrightarrow> h = 0 \<and> poly t = poly []"
  apply (simp add: fun_eq)
  apply (case_tac "h = zero")
  apply (drule_tac [2] x = zero in spec, auto)
  apply (cases "poly t = poly []", simp)
proof -
  fix x
  assume H: "\<forall>x. x = (0\<Colon>'a) \<or> poly t x = (0\<Colon>'a)"
    and pnz: "poly t \<noteq> poly []"
  let ?S = "{x. poly t x = 0}"
  from H have "\<forall>x. x \<noteq>0 \<longrightarrow> poly t x = 0" by blast
  hence th: "?S \<supseteq> UNIV - {0}" by auto
  from poly_roots_finite pnz have th': "finite ?S" by blast
  from finite_subset[OF th th'] UNIV_ring_char_0_infinte show "poly t x = (0\<Colon>'a)"
    by simp
qed

lemma (in idom_char_0) poly_zero: "(poly p = poly []) = list_all (%c. c = 0) p"
  apply (induct p)
  apply simp
  apply (rule iffI)
  apply (drule poly_zero_lemma', auto)
  done

lemma (in idom_char_0) poly_0: "list_all (\<lambda>c. c = 0) p \<Longrightarrow> poly p x = 0"
  unfolding poly_zero[symmetric] by simp

text{*Basics of divisibility.*}

lemma (in idom) poly_primes:
  "[a, 1] divides (p *** q) \<longleftrightarrow> [a, 1] divides p \<or> [a, 1] divides q"
  apply (auto simp add: divides_def fun_eq poly_mult poly_add poly_cmult distrib_right [symmetric])
  apply (drule_tac x = "uminus a" in spec)
  apply (simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric])
  apply (cases "p = []")
  apply (rule exI[where x="[]"])
  apply simp
  apply (cases "q = []")
  apply (erule allE[where x="[]"], simp)

  apply clarsimp
  apply (cases "\<exists>q\<Colon>'a list. p = a %* q +++ ((0\<Colon>'a) # q)")
  apply (clarsimp simp add: poly_add poly_cmult)
  apply (rule_tac x="qa" in exI)
  apply (simp add: distrib_right [symmetric])
  apply clarsimp

  apply (auto simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric])
  apply (rule_tac x = "pmult qa q" in exI)
  apply (rule_tac [2] x = "pmult p qa" in exI)
  apply (auto simp add: poly_add poly_mult poly_cmult ac_simps)
  done

lemma (in comm_semiring_1) poly_divides_refl[simp]: "p divides p"
  apply (simp add: divides_def)
  apply (rule_tac x = "[one]" in exI)
  apply (auto simp add: poly_mult fun_eq)
  done

lemma (in comm_semiring_1) poly_divides_trans: "p divides q \<Longrightarrow> q divides r \<Longrightarrow> p divides r"
  apply (simp add: divides_def, safe)
  apply (rule_tac x = "pmult qa qaa" in exI)
  apply (auto simp add: poly_mult fun_eq mult.assoc)
  done

lemma (in comm_semiring_1) poly_divides_exp: "m \<le> n \<Longrightarrow> (p %^ m) divides (p %^ n)"
  apply (auto simp add: le_iff_add)
  apply (induct_tac k)
  apply (rule_tac [2] poly_divides_trans)
  apply (auto simp add: divides_def)
  apply (rule_tac x = p in exI)
  apply (auto simp add: poly_mult fun_eq ac_simps)
  done

lemma (in comm_semiring_1) poly_exp_divides:
  "(p %^ n) divides q \<Longrightarrow> m \<le> n \<Longrightarrow> (p %^ m) divides q"
  by (blast intro: poly_divides_exp poly_divides_trans)

lemma (in comm_semiring_0) poly_divides_add:
  "p divides q \<Longrightarrow> p divides r \<Longrightarrow> p divides (q +++ r)"
  apply (simp add: divides_def, auto)
  apply (rule_tac x = "padd qa qaa" in exI)
  apply (auto simp add: poly_add fun_eq poly_mult distrib_left)
  done

lemma (in comm_ring_1) poly_divides_diff:
  "p divides q \<Longrightarrow> p divides (q +++ r) \<Longrightarrow> p divides r"
  apply (simp add: divides_def, auto)
  apply (rule_tac x = "padd qaa (poly_minus qa)" in exI)
  apply (auto simp add: poly_add fun_eq poly_mult poly_minus algebra_simps)
  done

lemma (in comm_ring_1) poly_divides_diff2:
  "p divides r \<Longrightarrow> p divides (q +++ r) \<Longrightarrow> p divides q"
  apply (erule poly_divides_diff)
  apply (auto simp add: poly_add fun_eq poly_mult divides_def ac_simps)
  done

lemma (in semiring_0) poly_divides_zero: "poly p = poly [] \<Longrightarrow> q divides p"
  apply (simp add: divides_def)
  apply (rule exI[where x="[]"])
  apply (auto simp add: fun_eq poly_mult)
  done

lemma (in semiring_0) poly_divides_zero2 [simp]: "q divides []"
  apply (simp add: divides_def)
  apply (rule_tac x = "[]" in exI)
  apply (auto simp add: fun_eq)
  done

text{*At last, we can consider the order of a root.*}

lemma (in idom_char_0) poly_order_exists_lemma:
  assumes lp: "length p = d"
    and p: "poly p \<noteq> poly []"
  shows "\<exists>n q. p = mulexp n [-a, 1] q \<and> poly q a \<noteq> 0"
  using lp p
proof (induct d arbitrary: p)
  case 0
  thus ?case by simp
next
  case (Suc n p)
  show ?case
  proof (cases "poly p a = 0")
    case True
    from Suc.prems have h: "length p = Suc n" "poly p \<noteq> poly []" by auto
    hence pN: "p \<noteq> []" by auto
    from True[unfolded poly_linear_divides] pN obtain q where q: "p = [-a, 1] *** q"
      by blast
    from q h True have qh: "length q = n" "poly q \<noteq> poly []"
      apply -
      apply simp
      apply (simp only: fun_eq)
      apply (rule ccontr)
      apply (simp add: fun_eq poly_add poly_cmult)
      done
    from Suc.hyps[OF qh] obtain m r where mr: "q = mulexp m [-a,1] r" "poly r a \<noteq> 0"
      by blast
    from mr q have "p = mulexp (Suc m) [-a,1] r \<and> poly r a \<noteq> 0" by simp
    then show ?thesis by blast
  next
    case False
    then show ?thesis
      using Suc.prems
      apply simp
      apply (rule exI[where x="0::nat"])
      apply simp
      done
  qed
qed

lemma (in comm_semiring_1) poly_mulexp: "poly (mulexp n p q) x = (poly p x) ^ n * poly q x"
  by (induct n) (auto simp add: poly_mult ac_simps)

lemma (in comm_semiring_1) divides_left_mult:
  assumes d:"(p***q) divides r" shows "p divides r \<and> q divides r"
proof-
  from d obtain t where r:"poly r = poly (p***q *** t)"
    unfolding divides_def by blast
  hence "poly r = poly (p *** (q *** t))"
    "poly r = poly (q *** (p***t))" by(auto simp add: fun_eq poly_mult ac_simps)
  thus ?thesis unfolding divides_def by blast
qed

(* FIXME: Tidy up *)

lemma (in semiring_1) zero_power_iff: "0 ^ n = (if n = 0 then 1 else 0)"
  by (induct n) simp_all

lemma (in idom_char_0) poly_order_exists:
  assumes "length p = d" and "poly p \<noteq> poly []"
  shows "\<exists>n. [- a, 1] %^ n divides p \<and> \<not> [- a, 1] %^ Suc n divides p"
proof -
  from assms have "\<exists>n q. p = mulexp n [- a, 1] q \<and> poly q a \<noteq> 0"
    by (rule poly_order_exists_lemma)
  then obtain n q where p: "p = mulexp n [- a, 1] q" and "poly q a \<noteq> 0" by blast
  have "[- a, 1] %^ n divides mulexp n [- a, 1] q"
  proof (rule dividesI)
    show "poly (mulexp n [- a, 1] q) = poly ([- a, 1] %^ n *** q)"
      by (induct n) (simp_all add: poly_add poly_cmult poly_mult algebra_simps)
  qed
  moreover have "\<not> [- a, 1] %^ Suc n divides mulexp n [- a, 1] q"
  proof
    assume "[- a, 1] %^ Suc n divides mulexp n [- a, 1] q"
    then obtain m where "poly (mulexp n [- a, 1] q) = poly ([- a, 1] %^ Suc n *** m)"
      by (rule dividesE)
    moreover have "poly (mulexp n [- a, 1] q) \<noteq> poly ([- a, 1] %^ Suc n *** m)"
    proof (induct n)
      case 0 show ?case
      proof (rule ccontr)
        assume "\<not> poly (mulexp 0 [- a, 1] q) \<noteq> poly ([- a, 1] %^ Suc 0 *** m)"
        then have "poly q a = 0"
          by (simp add: poly_add poly_cmult)
        with `poly q a \<noteq> 0` show False by simp
      qed
    next
      case (Suc n) show ?case
        by (rule pexp_Suc [THEN ssubst], rule ccontr)
          (simp add: poly_mult_left_cancel poly_mult_assoc Suc del: pmult_Cons pexp_Suc)
    qed
    ultimately show False by simp
  qed
  ultimately show ?thesis by (auto simp add: p)
qed

lemma (in semiring_1) poly_one_divides[simp]: "[1] divides p"
  by (auto simp add: divides_def)

lemma (in idom_char_0) poly_order:
  "poly p \<noteq> poly [] \<Longrightarrow> \<exists>!n. ([-a, 1] %^ n) divides p \<and> \<not> (([-a, 1] %^ Suc n) divides p)"
  apply (auto intro: poly_order_exists simp add: less_linear simp del: pmult_Cons pexp_Suc)
  apply (cut_tac x = y and y = n in less_linear)
  apply (drule_tac m = n in poly_exp_divides)
  apply (auto dest: Suc_le_eq [THEN iffD2, THEN [2] poly_exp_divides]
              simp del: pmult_Cons pexp_Suc)
  done

text{*Order*}

lemma some1_equalityD: "n = (SOME n. P n) \<Longrightarrow> \<exists>!n. P n \<Longrightarrow> P n"
  by (blast intro: someI2)

lemma (in idom_char_0) order:
      "(([-a, 1] %^ n) divides p \<and>
        ~(([-a, 1] %^ (Suc n)) divides p)) =
        ((n = order a p) \<and> ~(poly p = poly []))"
  apply (unfold order_def)
  apply (rule iffI)
  apply (blast dest: poly_divides_zero intro!: some1_equality [symmetric] poly_order)
  apply (blast intro!: poly_order [THEN [2] some1_equalityD])
  done

lemma (in idom_char_0) order2:
  "poly p \<noteq> poly [] \<Longrightarrow>
    ([-a, 1] %^ (order a p)) divides p \<and> \<not> (([-a, 1] %^ (Suc (order a p))) divides p)"
  by (simp add: order del: pexp_Suc)

lemma (in idom_char_0) order_unique:
  "poly p \<noteq> poly [] \<Longrightarrow> ([-a, 1] %^ n) divides p \<Longrightarrow> ~(([-a, 1] %^ (Suc n)) divides p) \<Longrightarrow>
    n = order a p"
  using order [of a n p] by auto

lemma (in idom_char_0) order_unique_lemma:
  "poly p \<noteq> poly [] \<and> ([-a, 1] %^ n) divides p \<and> ~(([-a, 1] %^ (Suc n)) divides p) \<Longrightarrow>
    n = order a p"
  by (blast intro: order_unique)

lemma (in ring_1) order_poly: "poly p = poly q \<Longrightarrow> order a p = order a q"
  by (auto simp add: fun_eq divides_def poly_mult order_def)

lemma (in semiring_1) pexp_one[simp]: "p %^ (Suc 0) = p"
  by (induct "p") auto

lemma (in comm_ring_1) lemma_order_root:
  "0 < n \<and> [- a, 1] %^ n divides p \<and> ~ [- a, 1] %^ (Suc n) divides p \<Longrightarrow> poly p a = 0"
  by (induct n arbitrary: a p) (auto simp add: divides_def poly_mult simp del: pmult_Cons)

lemma (in idom_char_0) order_root:
  "poly p a = 0 \<longleftrightarrow> poly p = poly [] \<or> order a p \<noteq> 0"
  apply (cases "poly p = poly []")
  apply auto
  apply (simp add: poly_linear_divides del: pmult_Cons, safe)
  apply (drule_tac [!] a = a in order2)
  apply (rule ccontr)
  apply (simp add: divides_def poly_mult fun_eq del: pmult_Cons, blast)
  using neq0_conv
  apply (blast intro: lemma_order_root)
  done

lemma (in idom_char_0) order_divides:
  "([-a, 1] %^ n) divides p \<longleftrightarrow> poly p = poly [] \<or> n \<le> order a p"
  apply (cases "poly p = poly []")
  apply auto
  apply (simp add: divides_def fun_eq poly_mult)
  apply (rule_tac x = "[]" in exI)
  apply (auto dest!: order2 [where a=a] intro: poly_exp_divides simp del: pexp_Suc)
  done

lemma (in idom_char_0) order_decomp:
  "poly p \<noteq> poly [] \<Longrightarrow> \<exists>q. poly p = poly (([-a, 1] %^ (order a p)) *** q) \<and> ~([-a, 1] divides q)"
  apply (unfold divides_def)
  apply (drule order2 [where a = a])
  apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe)
  apply (rule_tac x = q in exI, safe)
  apply (drule_tac x = qa in spec)
  apply (auto simp add: poly_mult fun_eq poly_exp ac_simps simp del: pmult_Cons)
  done

text{*Important composition properties of orders.*}
lemma order_mult:
  "poly (p *** q) \<noteq> poly [] \<Longrightarrow>
    order a (p *** q) = order a p + order (a::'a::{idom_char_0}) q"
  apply (cut_tac a = a and p = "p *** q" and n = "order a p + order a q" in order)
  apply (auto simp add: poly_entire simp del: pmult_Cons)
  apply (drule_tac a = a in order2)+
  apply safe
  apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe)
  apply (rule_tac x = "qa *** qaa" in exI)
  apply (simp add: poly_mult ac_simps del: pmult_Cons)
  apply (drule_tac a = a in order_decomp)+
  apply safe
  apply (subgoal_tac "[-a,1] divides (qa *** qaa) ")
  apply (simp add: poly_primes del: pmult_Cons)
  apply (auto simp add: divides_def simp del: pmult_Cons)
  apply (rule_tac x = qb in exI)
  apply (subgoal_tac "poly ([-a, 1] %^ (order a p) *** (qa *** qaa)) = poly ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))")
  apply (drule poly_mult_left_cancel [THEN iffD1], force)
  apply (subgoal_tac "poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** (qa *** qaa))) = poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))) ")
  apply (drule poly_mult_left_cancel [THEN iffD1], force)
  apply (simp add: fun_eq poly_exp_add poly_mult ac_simps del: pmult_Cons)
  done

lemma (in idom_char_0) order_mult:
  assumes "poly (p *** q) \<noteq> poly []"
  shows "order a (p *** q) = order a p + order a q"
  using assms
  apply (cut_tac a = a and p = "pmult p q" and n = "order a p + order a q" in order)
  apply (auto simp add: poly_entire simp del: pmult_Cons)
  apply (drule_tac a = a in order2)+
  apply safe
  apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe)
  apply (rule_tac x = "pmult qa qaa" in exI)
  apply (simp add: poly_mult ac_simps del: pmult_Cons)
  apply (drule_tac a = a in order_decomp)+
  apply safe
  apply (subgoal_tac "[uminus a, one] divides pmult qa qaa")
  apply (simp add: poly_primes del: pmult_Cons)
  apply (auto simp add: divides_def simp del: pmult_Cons)
  apply (rule_tac x = qb in exI)
  apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa)) =
    poly (pmult (pexp [uminus a, one] (?order a p)) (pmult [uminus a, one] qb))")
  apply (drule poly_mult_left_cancel [THEN iffD1], force)
  apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a q))
      (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa))) =
    poly (pmult (pexp [uminus a, one] (order a q))
      (pmult (pexp [uminus a, one] (order a p)) (pmult [uminus a, one] qb)))")
  apply (drule poly_mult_left_cancel [THEN iffD1], force)
  apply (simp add: fun_eq poly_exp_add poly_mult ac_simps del: pmult_Cons)
  done

lemma (in idom_char_0) order_root2: "poly p \<noteq> poly [] \<Longrightarrow> poly p a = 0 \<longleftrightarrow> order a p \<noteq> 0"
  by (rule order_root [THEN ssubst]) auto

lemma (in semiring_1) pmult_one[simp]: "[1] *** p = p" by auto

lemma (in semiring_0) poly_Nil_zero: "poly [] = poly [0]"
  by (simp add: fun_eq)

lemma (in idom_char_0) rsquarefree_decomp:
  "rsquarefree p \<Longrightarrow> poly p a = 0 \<Longrightarrow>
    \<exists>q. poly p = poly ([-a, 1] *** q) \<and> poly q a \<noteq> 0"
  apply (simp add: rsquarefree_def, safe)
  apply (frule_tac a = a in order_decomp)
  apply (drule_tac x = a in spec)
  apply (drule_tac a = a in order_root2 [symmetric])
  apply (auto simp del: pmult_Cons)
  apply (rule_tac x = q in exI, safe)
  apply (simp add: poly_mult fun_eq)
  apply (drule_tac p1 = q in poly_linear_divides [THEN iffD1])
  apply (simp add: divides_def del: pmult_Cons, safe)
  apply (drule_tac x = "[]" in spec)
  apply (auto simp add: fun_eq)
  done

text{*Normalization of a polynomial.*}

lemma (in semiring_0) poly_normalize[simp]: "poly (pnormalize p) = poly p"
  by (induct p) (auto simp add: fun_eq)

text{*The degree of a polynomial.*}

lemma (in semiring_0) lemma_degree_zero: "list_all (%c. c = 0) p \<longleftrightarrow> pnormalize p = []"
  by (induct p) auto

lemma (in idom_char_0) degree_zero:
  assumes "poly p = poly []"
  shows "degree p = 0"
  using assms
  by (cases "pnormalize p = []") (auto simp add: degree_def poly_zero lemma_degree_zero)

lemma (in semiring_0) pnormalize_sing: "(pnormalize [x] = [x]) \<longleftrightarrow> x \<noteq> 0"
  by simp

lemma (in semiring_0) pnormalize_pair: "y \<noteq> 0 \<longleftrightarrow> (pnormalize [x, y] = [x, y])"
  by simp

lemma (in semiring_0) pnormal_cons: "pnormal p \<Longrightarrow> pnormal (c#p)"
  unfolding pnormal_def by simp

lemma (in semiring_0) pnormal_tail: "p\<noteq>[] \<Longrightarrow> pnormal (c#p) \<Longrightarrow> pnormal p"
  unfolding pnormal_def by(auto split: split_if_asm)

lemma (in semiring_0) pnormal_last_nonzero: "pnormal p \<Longrightarrow> last p \<noteq> 0"
  by (induct p) (simp_all add: pnormal_def split: split_if_asm)

lemma (in semiring_0) pnormal_length: "pnormal p \<Longrightarrow> 0 < length p"
  unfolding pnormal_def length_greater_0_conv by blast

lemma (in semiring_0) pnormal_last_length: "0 < length p \<Longrightarrow> last p \<noteq> 0 \<Longrightarrow> pnormal p"
  by (induct p) (auto simp: pnormal_def  split: split_if_asm)

lemma (in semiring_0) pnormal_id: "pnormal p \<longleftrightarrow> 0 < length p \<and> last p \<noteq> 0"
  using pnormal_last_length pnormal_length pnormal_last_nonzero by blast

lemma (in idom_char_0) poly_Cons_eq:
  "poly (c # cs) = poly (d # ds) \<longleftrightarrow> c = d \<and> poly cs = poly ds"
  (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume eq: ?lhs
  hence "\<And>x. poly ((c#cs) +++ -- (d#ds)) x = 0"
    by (simp only: poly_minus poly_add algebra_simps) (simp add: algebra_simps)
  hence "poly ((c#cs) +++ -- (d#ds)) = poly []" by(simp add: fun_eq_iff)
  hence "c = d \<and> list_all (\<lambda>x. x=0) ((cs +++ -- ds))"
    unfolding poly_zero by (simp add: poly_minus_def algebra_simps)
  hence "c = d \<and> (\<forall>x. poly (cs +++ -- ds) x = 0)"
    unfolding poly_zero[symmetric] by simp
  then show ?rhs by (simp add: poly_minus poly_add algebra_simps fun_eq_iff)
next
  assume ?rhs
  then show ?lhs by(simp add:fun_eq_iff)
qed

lemma (in idom_char_0) pnormalize_unique: "poly p = poly q \<Longrightarrow> pnormalize p = pnormalize q"
proof (induct q arbitrary: p)
  case Nil
  thus ?case by (simp only: poly_zero lemma_degree_zero) simp
next
  case (Cons c cs p)
  thus ?case
  proof (induct p)
    case Nil
    hence "poly [] = poly (c#cs)" by blast
    then have "poly (c#cs) = poly [] " by simp
    thus ?case by (simp only: poly_zero lemma_degree_zero) simp
  next
    case (Cons d ds)
    hence eq: "poly (d # ds) = poly (c # cs)" by blast
    hence eq': "\<And>x. poly (d # ds) x = poly (c # cs) x" by simp
    hence "poly (d # ds) 0 = poly (c # cs) 0" by blast
    hence dc: "d = c" by auto
    with eq have "poly ds = poly cs"
      unfolding  poly_Cons_eq by simp
    with Cons.prems have "pnormalize ds = pnormalize cs" by blast
    with dc show ?case by simp
  qed
qed

lemma (in idom_char_0) degree_unique:
  assumes pq: "poly p = poly q"
  shows "degree p = degree q"
  using pnormalize_unique[OF pq] unfolding degree_def by simp

lemma (in semiring_0) pnormalize_length:
  "length (pnormalize p) \<le> length p" by (induct p) auto

lemma (in semiring_0) last_linear_mul_lemma:
  "last ((a %* p) +++ (x#(b %* p))) = (if p = [] then x else b * last p)"
  apply (induct p arbitrary: a x b)
  apply auto
  apply (rename_tac a p aa x b)
  apply (subgoal_tac "padd (cmult aa p) (times b a # cmult b p) \<noteq> []")
  apply simp
  apply (induct_tac p)
  apply auto
  done

lemma (in semiring_1) last_linear_mul:
  assumes p: "p \<noteq> []"
  shows "last ([a,1] *** p) = last p"
proof -
  from p obtain c cs where cs: "p = c#cs" by (cases p) auto
  from cs have eq: "[a,1] *** p = (a %* (c#cs)) +++ (0#(1 %* (c#cs)))"
    by (simp add: poly_cmult_distr)
  show ?thesis using cs
    unfolding eq last_linear_mul_lemma by simp
qed

lemma (in semiring_0) pnormalize_eq: "last p \<noteq> 0 \<Longrightarrow> pnormalize p = p"
  by (induct p) (auto split: split_if_asm)

lemma (in semiring_0) last_pnormalize: "pnormalize p \<noteq> [] \<Longrightarrow> last (pnormalize p) \<noteq> 0"
  by (induct p) auto

lemma (in semiring_0) pnormal_degree: "last p \<noteq> 0 \<Longrightarrow> degree p = length p - 1"
  using pnormalize_eq[of p] unfolding degree_def by simp

lemma (in semiring_0) poly_Nil_ext: "poly [] = (\<lambda>x. 0)"
  by (rule ext) simp

lemma (in idom_char_0) linear_mul_degree:
  assumes p: "poly p \<noteq> poly []"
  shows "degree ([a,1] *** p) = degree p + 1"
proof -
  from p have pnz: "pnormalize p \<noteq> []"
    unfolding poly_zero lemma_degree_zero .

  from last_linear_mul[OF pnz, of a] last_pnormalize[OF pnz]
  have l0: "last ([a, 1] *** pnormalize p) \<noteq> 0" by simp
  from last_pnormalize[OF pnz] last_linear_mul[OF pnz, of a]
    pnormal_degree[OF l0] pnormal_degree[OF last_pnormalize[OF pnz]] pnz

  have th: "degree ([a,1] *** pnormalize p) = degree (pnormalize p) + 1"
    by simp

  have eqs: "poly ([a,1] *** pnormalize p) = poly ([a,1] *** p)"
    by (rule ext) (simp add: poly_mult poly_add poly_cmult)
  from degree_unique[OF eqs] th
  show ?thesis by (simp add: degree_unique[OF poly_normalize])
qed

lemma (in idom_char_0) linear_pow_mul_degree:
  "degree([a,1] %^n *** p) = (if poly p = poly [] then 0 else degree p + n)"
proof (induct n arbitrary: a p)
  case (0 a p)
  show ?case
  proof (cases "poly p = poly []")
    case True
    then show ?thesis
      using degree_unique[OF True] by (simp add: degree_def)
  next
    case False
    then show ?thesis by (auto simp add: poly_Nil_ext)
  qed
next
  case (Suc n a p)
  have eq: "poly ([a,1] %^(Suc n) *** p) = poly ([a,1] %^ n *** ([a,1] *** p))"
    apply (rule ext)
    apply (simp add: poly_mult poly_add poly_cmult)
    apply (simp add: ac_simps ac_simps distrib_left)
    done
  note deq = degree_unique[OF eq]
  show ?case
  proof (cases "poly p = poly []")
    case True
    with eq have eq': "poly ([a,1] %^(Suc n) *** p) = poly []"
      apply -
      apply (rule ext)
      apply (simp add: poly_mult poly_cmult poly_add)
      done
    from degree_unique[OF eq'] True show ?thesis
      by (simp add: degree_def)
  next
    case False
    then have ap: "poly ([a,1] *** p) \<noteq> poly []"
      using poly_mult_not_eq_poly_Nil unfolding poly_entire by auto
    have eq: "poly ([a,1] %^(Suc n) *** p) = poly ([a,1]%^n *** ([a,1] *** p))"
      by (rule ext, simp add: poly_mult poly_add poly_exp poly_cmult algebra_simps)
    from ap have ap': "(poly ([a,1] *** p) = poly []) = False"
      by blast
    have th0: "degree ([a,1]%^n *** ([a,1] *** p)) = degree ([a,1] *** p) + n"
      apply (simp only: Suc.hyps[of a "pmult [a,one] p"] ap')
      apply simp
      done
    from degree_unique[OF eq] ap False th0 linear_mul_degree[OF False, of a]
    show ?thesis by (auto simp del: poly.simps)
  qed
qed

lemma (in idom_char_0) order_degree:
  assumes p0: "poly p \<noteq> poly []"
  shows "order a p \<le> degree p"
proof -
  from order2[OF p0, unfolded divides_def]
  obtain q where q: "poly p = poly ([- a, 1]%^ (order a p) *** q)" by blast
  {
    assume "poly q = poly []"
    with q p0 have False by (simp add: poly_mult poly_entire)
  }
  with degree_unique[OF q, unfolded linear_pow_mul_degree] show ?thesis
    by auto
qed

text{*Tidier versions of finiteness of roots.*}

lemma (in idom_char_0) poly_roots_finite_set:
  "poly p \<noteq> poly [] \<Longrightarrow> finite {x. poly p x = 0}"
  unfolding poly_roots_finite .

text{*bound for polynomial.*}

lemma poly_mono: "abs(x) \<le> k \<Longrightarrow> abs(poly p (x::'a::{linordered_idom})) \<le> poly (map abs p) k"
  apply (induct p)
  apply auto
  apply (rename_tac a p)
  apply (rule_tac y = "abs a + abs (x * poly p x)" in order_trans)
  apply (rule abs_triangle_ineq)
  apply (auto intro!: mult_mono simp add: abs_mult)
  done

lemma (in semiring_0) poly_Sing: "poly [c] x = c" by simp

end


(*  Title:      Binomial_Lemmas.thy
    Author:     Ata Keskin, TU München
*)

section \<open>Lemmas involving the binomial coefficient\<close>

text \<open>In this section, we prove lemmas that use the term for the binomial coefficient @{term choose}.\<close>

theory Binomial_Lemmas
  imports Main
begin

lemma choose_mono:
  assumes "x \<le> y"
  shows "x choose n \<le> y choose n"
proof -
  have "finite {0..<y}" by blast
  with finite_Pow_iff[of "{0..<y}"] have finiteness: "finite {K \<in> Pow {0..<y}. card K = n}" by simp
  from assms have "Pow {0..<x} \<subseteq> Pow {0..<y}" by force
  then have "{K \<in> Pow {0..<x}. card K = n} \<subseteq> {K \<in> Pow {0..<y}. card K = n}" by blast
  from card_mono[OF finiteness this] show ?thesis unfolding binomial_def .
qed

lemma choose_row_sum_set:
  assumes "finite (\<Union>F)"
  shows "card {S. S \<subseteq> \<Union>F \<and> card S \<le> k} = (\<Sum>i\<le>k. card (\<Union> F) choose i)"
proof (induction k)
  case 0
  from rev_finite_subset[OF assms] have "S \<subseteq> \<Union>F \<and> card S \<le> 0 \<longleftrightarrow> S = {}" for S by fastforce
  then show ?case by simp
next
  case (Suc k)
  let ?FS = "{S. S \<subseteq> \<Union> F \<and> card S \<le> Suc k}"
  and ?F_Asm = "{S. S \<subseteq> \<Union> F \<and> card S \<le> k}"
  and ?F_Step = "{S. S \<subseteq> \<Union> F \<and> card S = Suc k}"

  from finite_Pow_iff[of "\<Union>F"] assms have finite_Pow_Un_F: "finite (Pow (\<Union> F))" ..
  have "?F_Asm \<subseteq> Pow (\<Union> F)" and "?F_Step \<subseteq> Pow (\<Union> F)" by fast+
  with rev_finite_subset[OF finite_Pow_Un_F] have finite_F_Asm: "finite ?F_Asm" and finite_F_Step: "finite ?F_Step" by presburger+

  have F_Un: "?FS = ?F_Asm \<union> ?F_Step"  and F_disjoint: "?F_Asm \<inter> ?F_Step = {}" by fastforce+
  from card_Un_disjoint[OF finite_F_Asm finite_F_Step F_disjoint] F_Un have "card ?FS = card ?F_Asm + card ?F_Step" by argo
  also from Suc have "... = (\<Sum>i\<le>k. card (\<Union> F) choose i) + card ?F_Step" by argo
  also from n_subsets[OF assms, of "Suc k"] have "... = (\<Sum>i\<le>Suc k. card (\<Union> F) choose i)" by force
  finally show ?case by blast
qed

end


(*
  Title:    Set_Permutations.thy
  Author:   Manuel Eberl, TU München

  The set of permutations of a finite set, i.e. the set of all
  lists that contain every element of the set once.
*)

section \<open>Set Permutations\<close>

theory Set_Permutations
imports
  Complex_Main
  "~~/src/HOL/Library/Disjoint_Sets"
  "~~/src/HOL/Library/Permutations"
begin

(* TODO: Move? *)
lemma UN_cong: "A = B \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> UNION A f = UNION B g"
  by auto

lemma list_bind_cong [fundef_cong]:
  "(\<And>x. x \<in> set xs \<Longrightarrow> f x = g x) \<Longrightarrow> List.bind xs f = List.bind xs g"
  by (induction xs) simp_all

lemma set_list_bind: "set (List.bind xs f) = (\<Union>x\<in>set xs. set (f x))"
  by (induction xs) simp_all

lemma distinct_list_bind:
  assumes "distinct xs" "\<And>x. x \<in> set xs \<Longrightarrow> distinct (f x)"
          "disjoint_family_on (set \<circ> f) (set xs)"
  shows   "distinct (List.bind xs f)"
  using assms
  by (induction xs)
     (auto simp: disjoint_family_on_def distinct_map inj_on_def set_list_bind)

lemma permutes_inj_on: "\<sigma> permutes A \<Longrightarrow> inj_on \<sigma> B"
  by (drule permutes_inj) (unfold inj_on_def, blast)

lemma remove_induct [case_names empty infinite remove]:
  "P ({} :: 'a set) \<Longrightarrow> (\<And>A. infinite A \<Longrightarrow> P A) \<Longrightarrow> (\<And>A. finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow>
     (\<And>x. x \<in> A \<Longrightarrow> P (A - {x})) \<Longrightarrow> P A) \<Longrightarrow> P a0"
proof (induction_schema)
  fix A and x :: 'a assume "finite A" "x \<in> A" "A \<noteq> {}"
  moreover from this have "card A > 0" by (simp add: card_gt_0_iff)
  ultimately show "(A - {x}, A) \<in> Wellfounded.measure card" by simp
qed auto

lemma finite_remove_induct [consumes 1, case_names empty remove]:
  "finite a0 \<Longrightarrow> P {} \<Longrightarrow> (\<And>A. finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow>
     (\<And>x. x \<in> A \<Longrightarrow> P (A - {x})) \<Longrightarrow> P A) \<Longrightarrow> P a0"
  by (induction a0 rule: remove_induct) simp_all

(* END TODO *)

subsection \<open>Definition and general facts\<close>

definition permutations_of_set :: "'a set \<Rightarrow> 'a list set" where
  "permutations_of_set A = {xs. set xs = A \<and> distinct xs}"

lemma permutations_of_setI [intro]:
  assumes "set xs = A" "distinct xs"
  shows   "xs \<in> permutations_of_set A"
  using assms unfolding permutations_of_set_def by simp

lemma permutations_of_setD:
  assumes "xs \<in> permutations_of_set A"
  shows   "set xs = A" "distinct xs"
  using assms unfolding permutations_of_set_def by simp_all

lemma permutations_of_set_lists: "permutations_of_set A \<subseteq> lists A"
  unfolding permutations_of_set_def by auto

lemma permutations_of_set_empty [simp]: "permutations_of_set {} = {[]}"
  by (auto simp: permutations_of_set_def)

lemma UN_set_permutations_of_set [simp]:
  "finite A \<Longrightarrow> (\<Union>xs\<in>permutations_of_set A. set xs) = A"
  using finite_distinct_list by (auto simp: permutations_of_set_def)

lemma permutations_of_set_nonempty:
  assumes "A \<noteq> {}"
  shows "permutations_of_set A =
           (\<Union>x\<in>A. (\<lambda>xs. x # xs) ` permutations_of_set (A - {x}))" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix ys assume ys: "ys \<in> permutations_of_set A"
  with assms have "ys \<noteq> []" by (auto simp: permutations_of_set_def)
  then obtain x xs where xs: "ys = x # xs" by (cases ys) simp_all
  from xs ys have "x \<in> A" "xs \<in> permutations_of_set (A - {x})"
    by (auto simp: permutations_of_set_def)
  with xs show "ys \<in> ?rhs" by auto
next
  fix ys assume ys: "ys \<in> ?rhs"
  then obtain x xs where xs: "ys = x # xs" "x \<in> A" "xs \<in> permutations_of_set (A - {x})"
    by auto
  with ys show "ys \<in> ?lhs" by (auto simp: permutations_of_set_def)
qed

lemma permutations_of_set_singleton [simp]: "permutations_of_set {x} = {[x]}"
  by (subst permutations_of_set_nonempty) auto

lemma permutations_of_set_doubleton:
  "x \<noteq> y \<Longrightarrow> permutations_of_set {x,y} = {[x,y], [y,x]}"
  by (subst permutations_of_set_nonempty)
     (simp_all add: insert_Diff_if insert_commute)

lemma rev_permutations_of_set [simp]:
  "rev ` permutations_of_set A = permutations_of_set A"
proof
  have "rev ` rev ` permutations_of_set A \<subseteq> rev ` permutations_of_set A"
    unfolding permutations_of_set_def by auto
  also have "rev ` rev ` permutations_of_set A = permutations_of_set A"
    by (simp add: image_image)
  finally show "permutations_of_set A \<subseteq> rev ` permutations_of_set A" .
next
  show "rev ` permutations_of_set A \<subseteq> permutations_of_set A"
    unfolding permutations_of_set_def by auto
qed

lemma length_finite_permutations_of_set:
  "xs \<in> permutations_of_set A \<Longrightarrow> length xs = card A"
  by (auto simp: permutations_of_set_def distinct_card)

lemma permutations_of_set_infinite:
  "\<not>finite A \<Longrightarrow> permutations_of_set A = {}"
  by (auto simp: permutations_of_set_def)

lemma finite_permutations_of_set [simp]: "finite (permutations_of_set A)"
proof (cases "finite A")
  assume fin: "finite A"
  have "permutations_of_set A \<subseteq> {xs. set xs \<subseteq> A \<and> length xs = card A}"
    unfolding permutations_of_set_def by (auto simp: distinct_card)
  moreover from fin have "finite \<dots>" using finite_lists_length_eq by blast
  ultimately show ?thesis by (rule finite_subset)
qed (simp_all add: permutations_of_set_infinite)

lemma permutations_of_set_empty_iff [simp]:
  "permutations_of_set A = {} \<longleftrightarrow> \<not>finite A"
  unfolding permutations_of_set_def using finite_distinct_list[of A] by auto

lemma card_permutations_of_set [simp]:
  "finite A \<Longrightarrow> card (permutations_of_set A) = fact (card A)"
proof (induction A rule: finite_remove_induct)
  case (remove A)
  hence "card (permutations_of_set A) =
           card (\<Union>x\<in>A. op # x ` permutations_of_set (A - {x}))"
    by (simp add: permutations_of_set_nonempty)
  also from remove.hyps have "\<dots> = (\<Sum>i\<in>A. card (op # i ` permutations_of_set (A - {i})))"
    by (intro card_UN_disjoint) auto
  also have "\<dots> = (\<Sum>i\<in>A. card (permutations_of_set (A - {i})))"
    by (intro setsum.cong) (simp_all add: card_image)
  also from remove have "\<dots> = card A * fact (card A - 1)" by simp
  also from remove.hyps have "\<dots> = fact (card A)"
    by (cases "card A") simp_all
  finally show ?case .
qed simp_all

lemma permutations_of_set_image_inj:
  assumes inj: "inj_on f A"
  shows   "permutations_of_set (f ` A) = map f ` permutations_of_set A"
proof (cases "finite A")
  assume "\<not>finite A"
  with inj show ?thesis
    by (auto simp add: permutations_of_set_infinite dest: finite_imageD)
next
  assume finite: "finite A"
  show ?thesis
  proof (rule sym, rule card_seteq)
    from inj show "map f ` permutations_of_set A \<subseteq> permutations_of_set (f ` A)"
      by (auto simp: permutations_of_set_def distinct_map)

    from inj have "card (map f ` permutations_of_set A) = card (permutations_of_set A)"
      by (intro card_image inj_on_mapI) (auto simp: permutations_of_set_def)
    also from finite inj have "\<dots> = card (permutations_of_set (f ` A))"
      by (simp add: card_image)
    finally show "card (permutations_of_set (f ` A)) \<le>
                    card (map f ` permutations_of_set A)" by simp
  qed simp_all
qed

lemma permutations_of_set_image_permutes:
  "\<sigma> permutes A \<Longrightarrow> map \<sigma> ` permutations_of_set A = permutations_of_set A"
  by (subst permutations_of_set_image_inj [symmetric])
     (simp_all add: assms permutes_inj_on permutes_image)

subsection \<open>Code generation\<close>

text \<open>
  We define an auxiliary version with an accumulator to avoid
  having to map over the results.
\<close>
function permutations_of_set_aux where
  "permutations_of_set_aux acc A =
     (if \<not>finite A then {} else if A = {} then {acc} else
        (\<Union>x\<in>A. permutations_of_set_aux (x#acc) (A - {x})))"
by auto
termination by (relation "Wellfounded.measure (card \<circ> snd)") (simp_all add: card_gt_0_iff)

lemma permutations_of_set_aux_altdef:
  "permutations_of_set_aux acc A = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A"
proof (cases "finite A")
  assume "finite A"
  thus ?thesis
  proof (induction A arbitrary: acc rule: finite_psubset_induct)
    case (psubset A acc)
    show ?case
    proof (cases "A = {}")
      case False
      note [simp del] = permutations_of_set_aux.simps
      from psubset.hyps False
        have "permutations_of_set_aux acc A =
                (\<Union>y\<in>A. permutations_of_set_aux (y#acc) (A - {y}))"
        by (subst permutations_of_set_aux.simps) simp_all
      also have "\<dots> = (\<Union>y\<in>A. (\<lambda>xs. rev xs @ acc) ` (\<lambda>xs. y # xs) ` permutations_of_set (A - {y}))"
        by (intro UN_cong refl, subst psubset) (auto simp: image_image)
      also from False have "\<dots> = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A"
        by (subst (2) permutations_of_set_nonempty) (simp_all add: image_UN)
      finally show ?thesis .
    qed simp_all
  qed
qed (simp_all add: permutations_of_set_infinite)

declare permutations_of_set_aux.simps [simp del]

lemma permutations_of_set_aux_correct:
  "permutations_of_set_aux [] A = permutations_of_set A"
  by (simp add: permutations_of_set_aux_altdef)

text \<open>
  In another refinement step, we define a version on lists.
\<close>
declare length_remove1 [termination_simp]

fun permutations_of_set_aux_list where
  "permutations_of_set_aux_list acc xs =
     (if xs = [] then [acc] else
        List.bind xs (\<lambda>x. permutations_of_set_aux_list (x#acc) (List.remove1 x xs)))"

definition permutations_of_set_list where
  "permutations_of_set_list xs = permutations_of_set_aux_list [] xs"

declare permutations_of_set_aux_list.simps [simp del]

lemma permutations_of_set_aux_list_refine:
  assumes "distinct xs"
  shows   "set (permutations_of_set_aux_list acc xs) = permutations_of_set_aux acc (set xs)"
  using assms
  by (induction acc xs rule: permutations_of_set_aux_list.induct)
     (subst permutations_of_set_aux_list.simps,
      subst permutations_of_set_aux.simps,
      simp_all add: set_list_bind cong: UN_cong)

text \<open>
  The permutation lists contain no duplicates if the inputs contain no duplicates.
  Therefore, these functions can easily be used when working with a representation of
  sets by distinct lists.
  The same approach should generalise to any kind of set implementation that supports
  a monadic bind operation, and since the results are disjoint, merging should be cheap.
\<close>
lemma distinct_permutations_of_set_aux_list:
  "distinct xs \<Longrightarrow> distinct (permutations_of_set_aux_list acc xs)"
  by (induction acc xs rule: permutations_of_set_aux_list.induct)
     (subst permutations_of_set_aux_list.simps,
      auto intro!: distinct_list_bind simp: disjoint_family_on_def
         permutations_of_set_aux_list_refine permutations_of_set_aux_altdef)

lemma distinct_permutations_of_set_list:
    "distinct xs \<Longrightarrow> distinct (permutations_of_set_list xs)"
  by (simp add: permutations_of_set_list_def distinct_permutations_of_set_aux_list)

lemma permutations_of_list:
    "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))"
  by (simp add: permutations_of_set_aux_correct [symmetric]
        permutations_of_set_aux_list_refine permutations_of_set_list_def)

lemma permutations_of_list_code [code]:
  "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))"
  "permutations_of_set (List.coset xs) =
     Code.abort (STR ''Permutation of set complement not supported'')
       (\<lambda>_. permutations_of_set (List.coset xs))"
  by (simp_all add: permutations_of_list)

value [code] "permutations_of_set (set ''abcd'')"

end


(*  Title:      HOL/Isar_Examples/Group.thy
    Author:     Makarius
*)

section \<open>Basic group theory\<close>

theory Group
  imports Main
begin

subsection \<open>Groups and calculational reasoning\<close>

text \<open>
  Groups over signature \<open>(* :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>, 1 :: \<alpha>, inverse :: \<alpha> \<Rightarrow> \<alpha>)\<close> are
  defined as an axiomatic type class as follows. Note that the parent classes
  \<^class>\<open>times\<close>, \<^class>\<open>one\<close>, \<^class>\<open>inverse\<close> is provided by the basic HOL theory.
\<close>

class group = times + one + inverse +
  assumes group_assoc: "(x * y) * z = x * (y * z)"
    and group_left_one: "1 * x = x"
    and group_left_inverse: "inverse x * x = 1"

text \<open>
  The group axioms only state the properties of left one and inverse, the
  right versions may be derived as follows.
\<close>

theorem (in group) group_right_inverse: "x * inverse x = 1"
proof -
  have "x * inverse x = 1 * (x * inverse x)"
    by (simp only: group_left_one)
  also have "\<dots> = 1 * x * inverse x"
    by (simp only: group_assoc)
  also have "\<dots> = inverse (inverse x) * inverse x * x * inverse x"
    by (simp only: group_left_inverse)
  also have "\<dots> = inverse (inverse x) * (inverse x * x) * inverse x"
    by (simp only: group_assoc)
  also have "\<dots> = inverse (inverse x) * 1 * inverse x"
    by (simp only: group_left_inverse)
  also have "\<dots> = inverse (inverse x) * (1 * inverse x)"
    by (simp only: group_assoc)
  also have "\<dots> = inverse (inverse x) * inverse x"
    by (simp only: group_left_one)
  also have "\<dots> = 1"
    by (simp only: group_left_inverse)
  finally show ?thesis .
qed

text \<open>
  With \<open>group_right_inverse\<close> already available, \<open>group_right_one\<close>
  is now established much easier.
\<close>

theorem (in group) group_right_one: "x * 1 = x"
proof -
  have "x * 1 = x * (inverse x * x)"
    by (simp only: group_left_inverse)
  also have "\<dots> = x * inverse x * x"
    by (simp only: group_assoc)
  also have "\<dots> = 1 * x"
    by (simp only: group_right_inverse)
  also have "\<dots> = x"
    by (simp only: group_left_one)
  finally show ?thesis .
qed

text \<open>
  \<^medskip>
  The calculational proof style above follows typical presentations given in
  any introductory course on algebra. The basic technique is to form a
  transitive chain of equations, which in turn are established by simplifying
  with appropriate rules. The low-level logical details of equational
  reasoning are left implicit.

  Note that ``\<open>\<dots>\<close>'' is just a special term variable that is bound
  automatically to the argument\<^footnote>\<open>The argument of a curried infix expression
  happens to be its right-hand side.\<close> of the last fact achieved by any local
  assumption or proven statement. In contrast to \<open>?thesis\<close>, the ``\<open>\<dots>\<close>''
  variable is bound \<^emph>\<open>after\<close> the proof is finished.

  There are only two separate Isar language elements for calculational proofs:
  ``\<^theory_text>\<open>also\<close>'' for initial or intermediate calculational steps, and
  ``\<^theory_text>\<open>finally\<close>'' for exhibiting the result of a calculation. These constructs
  are not hardwired into Isabelle/Isar, but defined on top of the basic
  Isar/VM interpreter. Expanding the \<^theory_text>\<open>also\<close> and \<^theory_text>\<open>finally\<close> derived language
  elements, calculations may be simulated by hand as demonstrated below.
\<close>

theorem (in group) "x * 1 = x"
proof -
  have "x * 1 = x * (inverse x * x)"
    by (simp only: group_left_inverse)

  note calculation = this
    \<comment> \<open>first calculational step: init calculation register\<close>

  have "\<dots> = x * inverse x * x"
    by (simp only: group_assoc)

  note calculation = trans [OF calculation this]
    \<comment> \<open>general calculational step: compose with transitivity rule\<close>

  have "\<dots> = 1 * x"
    by (simp only: group_right_inverse)

  note calculation = trans [OF calculation this]
    \<comment> \<open>general calculational step: compose with transitivity rule\<close>

  have "\<dots> = x"
    by (simp only: group_left_one)

  note calculation = trans [OF calculation this]
    \<comment> \<open>final calculational step: compose with transitivity rule \dots\<close>
  from calculation
    \<comment> \<open>\dots\ and pick up the final result\<close>

  show ?thesis .
qed

text \<open>
  Note that this scheme of calculations is not restricted to plain
  transitivity. Rules like anti-symmetry, or even forward and backward
  substitution work as well. For the actual implementation of \<^theory_text>\<open>also\<close> and
  \<^theory_text>\<open>finally\<close>, Isabelle/Isar maintains separate context information of
  ``transitivity'' rules. Rule selection takes place automatically by
  higher-order unification.
\<close>

subsection \<open>Groups as monoids\<close>

text \<open>
  Monoids over signature \<open>(* :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>, 1 :: \<alpha>)\<close> are defined like this.
\<close>

class monoid = times + one +
  assumes monoid_assoc: "(x * y) * z = x * (y * z)"
    and monoid_left_one: "1 * x = x"
    and monoid_right_one: "x * 1 = x"

text \<open>
  Groups are \<^emph>\<open>not\<close> yet monoids directly from the definition. For monoids,
  \<open>right_one\<close> had to be included as an axiom, but for groups both \<open>right_one\<close>
  and \<open>right_inverse\<close> are derivable from the other axioms. With
  \<open>group_right_one\<close> derived as a theorem of group theory (see @{thm
  group_right_one}), we may still instantiate \<open>group \<subseteq> monoid\<close> properly as
  follows.
\<close>

instance group \<subseteq> monoid
  by intro_classes
    (rule group_assoc,
      rule group_left_one,
      rule group_right_one)

text \<open>
  The \<^theory_text>\<open>instance\<close> command actually is a version of \<^theory_text>\<open>theorem\<close>, setting up a
  goal that reflects the intended class relation (or type constructor arity).
  Thus any Isar proof language element may be involved to establish this
  statement. When concluding the proof, the result is transformed into the
  intended type signature extension behind the scenes.
\<close>

subsection \<open>More theorems of group theory\<close>

text \<open>
  The one element is already uniquely determined by preserving an \<^emph>\<open>arbitrary\<close>
  group element.
\<close>

theorem (in group) group_one_equality:
  assumes eq: "e * x = x"
  shows "1 = e"
proof -
  have "1 = x * inverse x"
    by (simp only: group_right_inverse)
  also have "\<dots> = (e * x) * inverse x"
    by (simp only: eq)
  also have "\<dots> = e * (x * inverse x)"
    by (simp only: group_assoc)
  also have "\<dots> = e * 1"
    by (simp only: group_right_inverse)
  also have "\<dots> = e"
    by (simp only: group_right_one)
  finally show ?thesis .
qed

text \<open>
  Likewise, the inverse is already determined by the cancel property.
\<close>

theorem (in group) group_inverse_equality:
  assumes eq: "x' * x = 1"
  shows "inverse x = x'"
proof -
  have "inverse x = 1 * inverse x"
    by (simp only: group_left_one)
  also have "\<dots> = (x' * x) * inverse x"
    by (simp only: eq)
  also have "\<dots> = x' * (x * inverse x)"
    by (simp only: group_assoc)
  also have "\<dots> = x' * 1"
    by (simp only: group_right_inverse)
  also have "\<dots> = x'"
    by (simp only: group_right_one)
  finally show ?thesis .
qed

text \<open>
  The inverse operation has some further characteristic properties.
\<close>

theorem (in group) group_inverse_times: "inverse (x * y) = inverse y * inverse x"
proof (rule group_inverse_equality)
  show "(inverse y * inverse x) * (x * y) = 1"
  proof -
    have "(inverse y * inverse x) * (x * y) =
        (inverse y * (inverse x * x)) * y"
      by (simp only: group_assoc)
    also have "\<dots> = (inverse y * 1) * y"
      by (simp only: group_left_inverse)
    also have "\<dots> = inverse y * y"
      by (simp only: group_right_one)
    also have "\<dots> = 1"
      by (simp only: group_left_inverse)
    finally show ?thesis .
  qed
qed

theorem (in group) inverse_inverse: "inverse (inverse x) = x"
proof (rule group_inverse_equality)
  show "x * inverse x = one"
    by (simp only: group_right_inverse)
qed

theorem (in group) inverse_inject:
  assumes eq: "inverse x = inverse y"
  shows "x = y"
proof -
  have "x = x * 1"
    by (simp only: group_right_one)
  also have "\<dots> = x * (inverse y * y)"
    by (simp only: group_left_inverse)
  also have "\<dots> = x * (inverse x * y)"
    by (simp only: eq)
  also have "\<dots> = (x * inverse x) * y"
    by (simp only: group_assoc)
  also have "\<dots> = 1 * y"
    by (simp only: group_right_inverse)
  also have "\<dots> = y"
    by (simp only: group_left_one)
  finally show ?thesis .
qed

end


theorem sqrt2_not_rational:
"sqrt 2 ∉ Q"
proof
let ?x = "sqrt 2"
assume "?x ∈ Q"
then obtain m n :: nat where
sqrt_rat: "¦?x¦ = m / n" and lowest_terms: "coprime m n"
by (rule Rats_abs_nat_div_natE)
hence "m^2 = ?x^2 * n^2" by (auto simp add: power2_eq_square)
hence eq: "m^2 = 2 * n^2" using of_nat_eq_iff power2_eq_square by fastforce
hence "2 dvd m^2" by simp
hence "2 dvd m" by simp
have "2 dvd n" proof -
from ‹2 dvd m› obtain k where "m = 2 * k" ..
with eq have "2 * n^2 = 2^2 * k^2" by simp
hence "2 dvd n^2" by simp
thus "2 dvd n" by simp
qed
with ‹2 dvd m› have "2 dvd gcd m n" by (rule gcd_greatest)
with lowest_terms have "2 dvd 1" by simp
thus False using odd_one by blast
qed
(* End of Isabelle syntax identification sample *)

(* Project language file 1
For: seanpm2001/Learn-Isabelle
About:
I chose Isabelle as the first project language file for this project (Seanpm2001/Learn-Isabelle) as this project is about learning th Isabelle programming language, and showing my knowledge for the language. Its project language file should represent what language is being showcased and studied here.
*)

(* File info
File type: Isabelle source file (*.thy)
File version: 1 (2022, Thursday, April 21st at 6:56 pm PST)
Line count (including blank lines and compiler line): 36
*)


(*
  File:   Master_Theorem_Examples.thy
  Author: Manuel Eberl <eberlm@in.tum.de>

  Examples for the application of the Master theorem and related proof methods.
*)

section \<open>Examples\<close>
theory Master_Theorem_Examples
imports
  Complex_Main
  Akra_Bazzi_Method
  Akra_Bazzi_Approximation
begin

subsection \<open>Merge sort\<close>

(* A merge sort cost function that is parametrised with the recombination costs *)
function merge_sort_cost :: "(nat \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> real" where
  "merge_sort_cost t 0 = 0"
| "merge_sort_cost t 1 = 1"
| "n \<ge> 2 \<Longrightarrow> merge_sort_cost t n =
     merge_sort_cost t (nat \<lfloor>real n / 2\<rfloor>) + merge_sort_cost t (nat \<lceil>real n / 2\<rceil>) + t n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma merge_sort_nonneg[simp]: "(\<And>n. t n \<ge> 0) \<Longrightarrow> merge_sort_cost t x \<ge> 0"
  by (induction t x rule: merge_sort_cost.induct) (simp_all del: One_nat_def)

lemma "t \<in> \<Theta>(\<lambda>n. real n) \<Longrightarrow> (\<And>n. t n \<ge> 0) \<Longrightarrow> merge_sort_cost t \<in> \<Theta>(\<lambda>n. real n * ln (real n))"
  by (master_theorem 2.3) simp_all

subsection \<open>Karatsuba multiplication\<close>

function karatsuba_cost :: "nat \<Rightarrow> real" where
  "karatsuba_cost 0 = 0"
| "karatsuba_cost 1 = 1"
| "n \<ge> 2 \<Longrightarrow> karatsuba_cost n =
     3 * karatsuba_cost (nat \<lceil>real n / 2\<rceil>) + real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma karatsuba_cost_nonneg[simp]: "karatsuba_cost n \<ge> 0"
  by (induction n rule: karatsuba_cost.induct) (simp_all del: One_nat_def)

lemma "karatsuba_cost \<in> O(\<lambda>n. real n powr log 2 3)"
   by (master_theorem 1 p': 1) (simp_all add: powr_divide)

lemma karatsuba_cost_pos: "n \<ge> 1 \<Longrightarrow> karatsuba_cost n > 0"
  by (induction n rule: karatsuba_cost.induct) (auto intro!: add_nonneg_pos simp del: One_nat_def)

lemma "karatsuba_cost \<in> \<Theta>(\<lambda>n. real n powr log 2 3)"
  using karatsuba_cost_pos
  by (master_theorem 1 p': 1) (auto simp add: powr_divide eventually_at_top_linorder)

subsection \<open>Strassen matrix multiplication\<close>

function strassen_cost :: "nat \<Rightarrow> real" where
  "strassen_cost 0 = 0"
| "strassen_cost 1 = 1"
| "n \<ge> 2 \<Longrightarrow> strassen_cost n = 7 * strassen_cost (nat \<lceil>real n / 2\<rceil>) + real (n^2)"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma strassen_cost_nonneg[simp]: "strassen_cost n \<ge> 0"
  by (induction n rule: strassen_cost.induct) (simp_all del: One_nat_def)

lemma "strassen_cost \<in> O(\<lambda>n. real n powr log 2 7)"
  by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder)

lemma strassen_cost_pos: "n \<ge> 1 \<Longrightarrow> strassen_cost n > 0"
  by (cases n rule: strassen_cost.cases) (simp_all add: add_nonneg_pos del: One_nat_def)

lemma "strassen_cost \<in> \<Theta>(\<lambda>n. real n powr log 2 7)"
  using strassen_cost_pos
  by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder)

subsection \<open>Deterministic select\<close>

(* This is not possible with the standard Master theorem from literature *)
function select_cost :: "nat \<Rightarrow> real" where
  "n \<le> 20 \<Longrightarrow> select_cost n = 0"
| "n > 20 \<Longrightarrow> select_cost n =
     select_cost (nat \<lfloor>real n / 5\<rfloor>) + select_cost (nat \<lfloor>7 * real n / 10\<rfloor> + 6) + 12 * real n / 5"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "select_cost \<in> \<Theta>(\<lambda>n. real n)"
  by (master_theorem 3) auto

subsection \<open>Decreasing function\<close>

function dec_cost :: "nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> dec_cost n = 1"
| "n > 2 \<Longrightarrow> dec_cost n = 0.5*dec_cost (nat \<lfloor>real n / 2\<rfloor>) + 1 / real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "dec_cost \<in> \<Theta>(\<lambda>x::nat. ln x / x)"
  by (master_theorem 2.3) simp_all

subsection \<open>Example taken from Drmota and Szpakowski\<close>

function drmota1 :: "nat \<Rightarrow> real" where
  "n < 20 \<Longrightarrow> drmota1 n = 1"
| "n \<ge> 20 \<Longrightarrow> drmota1 n = 2 * drmota1 (nat \<lfloor>real n/2\<rfloor>) + 8/9 * drmota1 (nat \<lfloor>3*real n/4\<rfloor>) + real n^2 / ln (real n)"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "drmota1 \<in> \<Theta>(\<lambda>n::real. n^2 * ln (ln n))"
  by (master_theorem 2.2) (simp_all add: power_divide)

function drmota2 :: "nat \<Rightarrow> real" where
  "n < 20 \<Longrightarrow> drmota2 n = 1"
| "n \<ge> 20 \<Longrightarrow> drmota2 n = 1/3 * drmota2 (nat \<lfloor>real n/3 + 1/2\<rfloor>) + 2/3 * drmota2 (nat \<lfloor>2*real n/3 - 1/2\<rfloor>) + 1"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "drmota2 \<in> \<Theta>(\<lambda>x. ln (real x))"
  by master_theorem simp_all

(* Average phrase length of Boncelet arithmetic coding. See Drmota and Szpankowski. *)
lemma boncelet_phrase_length:
  fixes p \<delta> :: real assumes p: "p > 0" "p < 1" and \<delta>: "\<delta> > 0" "\<delta> < 1" "2*p + \<delta> < 2"
  fixes d :: "nat \<Rightarrow> real"
  defines "q \<equiv> 1 - p"
  assumes d_nonneg: "\<And>n. d n \<ge> 0"
  assumes d_rec: "\<And>n. n \<ge> 2 \<Longrightarrow> d n = 1 + p * d (nat \<lfloor>p * real n + \<delta>\<rfloor>) + q * d (nat \<lfloor>q * real n - \<delta>\<rfloor>)"
  shows   "d \<in> \<Theta>(\<lambda>x. ln x)"
  using assms by (master_theorem recursion: d_rec, simp_all)

subsection \<open>Transcendental exponents\<close>

(* Certain number-theoretic conjectures would imply that if all the parameters are rational,
   the Akra-Bazzi parameter is either rational or transcendental. That makes this case
   probably transcendental *)
function foo_cost :: "nat \<Rightarrow> real" where
  "n < 200 \<Longrightarrow> foo_cost n = 0"
| "n \<ge> 200 \<Longrightarrow> foo_cost n =
     foo_cost (nat \<lfloor>real n / 3\<rfloor>) + foo_cost (nat \<lfloor>3 * real n / 4\<rfloor> + 42) + real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma foo_cost_nonneg [simp]: "foo_cost n \<ge> 0"
  by (induction n rule: foo_cost.induct) simp_all

lemma "foo_cost \<in> \<Theta>(\<lambda>n. real n powr akra_bazzi_exponent [1,1] [1/3,3/4])"
proof (master_theorem 1 p': 1)
  have "\<forall>n\<ge>200. foo_cost n > 0" by (simp add: add_nonneg_pos)
  thus "eventually (\<lambda>n. foo_cost n > 0) at_top" unfolding eventually_at_top_linorder by blast
qed simp_all

lemma "akra_bazzi_exponent [1,1] [1/3,3/4] \<in> {1.1519623..1.1519624}"
  by (akra_bazzi_approximate 29)

subsection \<open>Functions in locale contexts\<close>

locale det_select =
  fixes b :: real
  assumes b: "b > 0" "b < 7/10"
begin

function select_cost' :: "nat \<Rightarrow> real" where
  "n \<le> 20 \<Longrightarrow> select_cost' n = 0"
| "n > 20 \<Longrightarrow> select_cost' n =
     select_cost' (nat \<lfloor>real n / 5\<rfloor>) + select_cost' (nat \<lfloor>b * real n\<rfloor> + 6) + 6 * real n + 5"
by force simp_all
termination using b by akra_bazzi_termination simp_all

lemma "a \<ge> 0 \<Longrightarrow> select_cost' \<in> \<Theta>(\<lambda>n. real n)"
  using b by (master_theorem 3, force+)

end

subsection \<open>Non-curried functions\<close>

(* Note: either a or b could be seen as recursion variables. *)
function baz_cost :: "nat \<times> nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> baz_cost (a, n) = 0"
| "n > 2 \<Longrightarrow> baz_cost (a, n) = 3 * baz_cost (a, nat \<lfloor>real n / 2\<rfloor>) + real a"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma baz_cost_nonneg [simp]: "a \<ge> 0 \<Longrightarrow> baz_cost (a, n) \<ge> 0"
  by (induction a n rule: baz_cost.induct[split_format (complete)]) simp_all

lemma
  assumes "a > 0"
  shows   "(\<lambda>x. baz_cost (a, x)) \<in> \<Theta>(\<lambda>x. x powr log 2 3)"
proof (master_theorem 1 p': 0)
  from assms have "\<forall>x\<ge>3. baz_cost (a, x) > 0" by (auto intro: add_nonneg_pos)
  thus "eventually (\<lambda>x. baz_cost (a, x) > 0) at_top" by (force simp: eventually_at_top_linorder)
qed (insert assms, simp_all add: powr_divide)

(* Non-"Akra-Bazzi" variables may even be modified without impacting the termination proof.
   However, the Akra-Bazzi theorem and the Master theorem itself do not apply anymore,
   because bar_cost cannot be seen as a recursive function with one parameter *)
function bar_cost :: "nat \<times> nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> bar_cost (a, n) = 0"
| "n > 2 \<Longrightarrow> bar_cost (a, n) = 3 * bar_cost (2 * a, nat \<lfloor>real n / 2\<rfloor>) + real a"
by force simp_all
termination by akra_bazzi_termination simp_all

subsection \<open>Ham-sandwich trees\<close>
(* f(n) = f(n/4) + f(n/2) + 1 *)
function ham_sandwich_cost :: "nat \<Rightarrow> real" where
  "n < 4 \<Longrightarrow> ham_sandwich_cost n = 1"
| "n \<ge> 4 \<Longrightarrow> ham_sandwich_cost n =
      ham_sandwich_cost (nat \<lfloor>n/4\<rfloor>) + ham_sandwich_cost (nat \<lfloor>n/2\<rfloor>) + 1"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma ham_sandwich_cost_pos [simp]: "ham_sandwich_cost n > 0"
  by (induction n rule: ham_sandwich_cost.induct) simp_all

text \<open>The golden ratio\<close>

definition "\<phi> = ((1 + sqrt 5) / 2 :: real)"

lemma \<phi>_pos [simp]: "\<phi> > 0" and \<phi>_nonneg [simp]: "\<phi> \<ge> 0" and \<phi>_nonzero [simp]: "\<phi> \<noteq> 0"
proof-
  show "\<phi> > 0" unfolding \<phi>_def by (simp add: add_pos_nonneg)
  thus "\<phi> \<ge> 0" "\<phi> \<noteq> 0" by simp_all
qed

lemma "ham_sandwich_cost \<in> \<Theta>(\<lambda>n. n powr (log 2 \<phi>))"
proof (master_theorem 1 p': 0)
  have "(1 / 4) powr log 2 \<phi> + (1 / 2) powr log 2 \<phi> =
            inverse (2 powr log 2 \<phi>)^2 + inverse (2 powr log 2 \<phi>)"
        by (simp add: powr_divide field_simps powr_powr power2_eq_square powr_mult[symmetric]
                 del: powr_log_cancel)
  also have "... = inverse (\<phi>^2) + inverse \<phi>" by (simp add: power2_eq_square)
  also have "\<phi> + 1 = \<phi>*\<phi>" by (simp add: \<phi>_def field_simps)
  hence "inverse (\<phi>^2) + inverse \<phi> = 1" by (simp add: field_simps power2_eq_square)
  finally show "(1 / 4) powr log 2 \<phi> + (1 / 2) powr log 2 \<phi> = 1" by simp
qed simp_all

end


(*  Title:      HOL/Library/Indicator_Function.thy
    Author:     Johannes Hoelzl (TU Muenchen)
*)

section \<open>Indicator Function\<close>

theory Indicator_Function
imports Complex_Main Disjoint_Sets
begin

definition "indicator S x = (if x \<in> S then 1 else 0)"

text\<open>Type constrained version\<close>
abbreviation indicat_real :: "'a set \<Rightarrow> 'a \<Rightarrow> real" where "indicat_real S \<equiv> indicator S"

lemma indicator_simps[simp]:
  "x \<in> S \<Longrightarrow> indicator S x = 1"
  "x \<notin> S \<Longrightarrow> indicator S x = 0"
  unfolding indicator_def by auto

lemma indicator_pos_le[intro, simp]: "(0::'a::linordered_semidom) \<le> indicator S x"
  and indicator_le_1[intro, simp]: "indicator S x \<le> (1::'a::linordered_semidom)"
  unfolding indicator_def by auto

lemma indicator_abs_le_1: "\<bar>indicator S x\<bar> \<le> (1::'a::linordered_idom)"
  unfolding indicator_def by auto

lemma indicator_eq_0_iff: "indicator A x = (0::'a::zero_neq_one) \<longleftrightarrow> x \<notin> A"
  by (auto simp: indicator_def)

lemma indicator_eq_1_iff: "indicator A x = (1::'a::zero_neq_one) \<longleftrightarrow> x \<in> A"
  by (auto simp: indicator_def)

lemma indicator_UNIV [simp]: "indicator UNIV = (\<lambda>x. 1)"
  by auto

lemma indicator_leI:
  "(x \<in> A \<Longrightarrow> y \<in> B) \<Longrightarrow> (indicator A x :: 'a::linordered_nonzero_semiring) \<le> indicator B y"
  by (auto simp: indicator_def)

lemma split_indicator: "P (indicator S x) \<longleftrightarrow> ((x \<in> S \<longrightarrow> P 1) \<and> (x \<notin> S \<longrightarrow> P 0))"
  unfolding indicator_def by auto

lemma split_indicator_asm: "P (indicator S x) \<longleftrightarrow> (\<not> (x \<in> S \<and> \<not> P 1 \<or> x \<notin> S \<and> \<not> P 0))"
  unfolding indicator_def by auto

lemma indicator_inter_arith: "indicator (A \<inter> B) x = indicator A x * (indicator B x::'a::semiring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_union_arith:
  "indicator (A \<union> B) x = indicator A x + indicator B x - indicator A x * (indicator B x :: 'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_inter_min: "indicator (A \<inter> B) x = min (indicator A x) (indicator B x::'a::linordered_semidom)"
  and indicator_union_max: "indicator (A \<union> B) x = max (indicator A x) (indicator B x::'a::linordered_semidom)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_disj_union:
  "A \<inter> B = {} \<Longrightarrow> indicator (A \<union> B) x = (indicator A x + indicator B x :: 'a::linordered_semidom)"
  by (auto split: split_indicator)

lemma indicator_compl: "indicator (- A) x = 1 - (indicator A x :: 'a::ring_1)"
  and indicator_diff: "indicator (A - B) x = indicator A x * (1 - indicator B x ::'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_times:
  "indicator (A \<times> B) x = indicator A (fst x) * (indicator B (snd x) :: 'a::semiring_1)"
  unfolding indicator_def by (cases x) auto

lemma indicator_sum:
  "indicator (A <+> B) x = (case x of Inl x \<Rightarrow> indicator A x | Inr x \<Rightarrow> indicator B x)"
  unfolding indicator_def by (cases x) auto

lemma indicator_image: "inj f \<Longrightarrow> indicator (f ` X) (f x) = (indicator X x::_::zero_neq_one)"
  by (auto simp: indicator_def inj_def)

lemma indicator_vimage: "indicator (f -` A) x = indicator A (f x)"
  by (auto split: split_indicator)

lemma  (* FIXME unnamed!? *)
  fixes f :: "'a \<Rightarrow> 'b::semiring_1"
  assumes "finite A"
  shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator B x) = (\<Sum>x \<in> A \<inter> B. f x)"
    and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator B x * f x) = (\<Sum>x \<in> A \<inter> B. f x)"
  unfolding indicator_def
  using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)

lemma sum_indicator_eq_card:
  assumes "finite A"
  shows "(\<Sum>x \<in> A. indicator B x) = card (A Int B)"
  using sum_mult_indicator [OF assms, of "\<lambda>x. 1::nat"]
  unfolding card_eq_sum by simp

lemma sum_indicator_scaleR[simp]:
  "finite A \<Longrightarrow>
    (\<Sum>x \<in> A. indicator (B x) (g x) *\<^sub>R f x) = (\<Sum>x \<in> {x\<in>A. g x \<in> B x}. f x :: 'a::real_vector)"
  by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm simp: indicator_def)

lemma LIMSEQ_indicator_incseq:
  assumes "incseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where "x \<in> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 1"
    "(indicator (\<Union>i. A i) x :: 'a) = 1"
    using incseqD[OF \<open>incseq A\<close>, of i "n + i" for n] \<open>x \<in> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_UN:
  "(\<lambda>k. indicator (\<Union>i<k. A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Union>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Union>k. \<Union>i<k. A i) x"
    by (intro LIMSEQ_indicator_incseq) (auto simp: incseq_def intro: less_le_trans)
  also have "(\<Union>k. \<Union>i<k. A i) = (\<Union>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma LIMSEQ_indicator_decseq:
  assumes "decseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof (cases "\<exists>i. x \<notin> A i")
  case True
  then obtain i where "x \<notin> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 0"
    "(indicator (\<Inter>i. A i) x :: 'a) = 0"
    using decseqD[OF \<open>decseq A\<close>, of i "n + i" for n] \<open>x \<notin> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_INT:
  "(\<lambda>k. indicator (\<Inter>i<k. A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Inter>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Inter>k. \<Inter>i<k. A i) x"
    by (intro LIMSEQ_indicator_decseq) (auto simp: decseq_def intro: less_le_trans)
  also have "(\<Inter>k. \<Inter>i<k. A i) = (\<Inter>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma indicator_add:
  "A \<inter> B = {} \<Longrightarrow> (indicator A x::_::monoid_add) + indicator B x = indicator (A \<union> B) x"
  unfolding indicator_def by auto

lemma of_real_indicator: "of_real (indicator A x) = indicator A x"
  by (simp split: split_indicator)

lemma real_of_nat_indicator: "real (indicator A x :: nat) = indicator A x"
  by (simp split: split_indicator)

lemma abs_indicator: "\<bar>indicator A x :: 'a::linordered_idom\<bar> = indicator A x"
  by (simp split: split_indicator)

lemma mult_indicator_subset:
  "A \<subseteq> B \<Longrightarrow> indicator A x * indicator B x = (indicator A x :: 'a::comm_semiring_1)"
  by (auto split: split_indicator simp: fun_eq_iff)

lemma indicator_times_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::comm_ring_1"
  shows "indicator S x * f x = (if x \<in> S then f x else 0)" "f x * indicator S x = (if x \<in> S then f x else 0)"
  by auto

lemma indicator_scaleR_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::real_vector"
  shows "indicator S x *\<^sub>R f x = (if x \<in> S then f x else 0)"
  by simp

lemma indicator_sums:
  assumes "\<And>i j. i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
  shows "(\<lambda>i. indicator (A i) x::real) sums indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where i: "x \<in> A i" ..
  with assms have "(\<lambda>i. indicator (A i) x::real) sums (\<Sum>i\<in>{i}. indicator (A i) x)"
    by (intro sums_finite) (auto split: split_indicator)
  also have "(\<Sum>i\<in>{i}. indicator (A i) x) = indicator (\<Union>i. A i) x"
    using i by (auto split: split_indicator)
  finally show ?thesis .
next
  case False
  then show ?thesis by simp
qed

text \<open>
  The indicator function of the union of a disjoint family of sets is the
  sum over all the individual indicators.
\<close>

lemma indicator_UN_disjoint:
  "finite A \<Longrightarrow> disjoint_family_on f A \<Longrightarrow> indicator (\<Union>(f ` A)) x = (\<Sum>y\<in>A. indicator (f y) x)"
  by (induct A rule: finite_induct)
    (auto simp: disjoint_family_on_def indicator_def split: if_splits)

end


theory Integral_Test
imports
  Complex_Main
  "~~/src/HOL/Multivariate_Analysis/Integration"
begin

subsubsection \<open>Integral test\<close>

locale antimono_fun_sum_integral_diff =
  fixes f :: "real \<Rightarrow> real"
  assumes dec: "\<And>x y. x \<ge> 0 \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<ge> f y"
  assumes nonneg: "\<And>x. x \<ge> 0 \<Longrightarrow> f x \<ge> 0"
  assumes cont: "continuous_on {0..} f"
begin

definition "sum_integral_diff_series n = (\<Sum>k\<le>n. f (of_nat k)) - (integral {0..of_nat n} f)"

lemma sum_integral_diff_series_nonneg:
  "sum_integral_diff_series n \<ge> 0"
proof -
  note int = integrable_continuous_real[OF continuous_on_subset[OF cont]]
  let ?int = "\<lambda>a b. integral {of_nat a..of_nat b} f"
  have "-sum_integral_diff_series n = ?int 0 n - (\<Sum>k\<le>n. f (of_nat k))"
    by (simp add: sum_integral_diff_series_def)
  also have "?int 0 n = (\<Sum>k<n. ?int k (Suc k))"
  proof (induction n)
    case (Suc n)
    have "?int 0 (Suc n) = ?int 0 n + ?int n (Suc n)"
      by (intro integral_combine[symmetric] int) simp_all
    with Suc show ?case by simp
  qed simp_all
  also have "... \<le> (\<Sum>k<n. integral {of_nat k..of_nat (Suc k)} (\<lambda>_::real. f (of_nat k)))"
    by (intro setsum_mono integral_le int) (auto intro: dec)
  also have "... = (\<Sum>k<n. f (of_nat k))" by simp
  also have "\<dots> - (\<Sum>k\<le>n. f (of_nat k)) = -(\<Sum>k\<in>{..n} - {..<n}. f (of_nat k))"
    by (subst setsum_diff) auto
  also have "\<dots> \<le> 0" by (auto intro!: setsum_nonneg nonneg)
  finally show "sum_integral_diff_series n \<ge> 0" by simp
qed

lemma sum_integral_diff_series_antimono:
  assumes "m \<le> n"
  shows   "sum_integral_diff_series m \<ge> sum_integral_diff_series n"
proof -
  let ?int = "\<lambda>a b. integral {of_nat a..of_nat b} f"
  note int = integrable_continuous_real[OF continuous_on_subset[OF cont]]
  have d_mono: "sum_integral_diff_series (Suc n) \<le> sum_integral_diff_series n" for n
  proof -
    fix n :: nat
    have "sum_integral_diff_series (Suc n) - sum_integral_diff_series n =
            f (of_nat (Suc n)) + (?int 0 n - ?int 0 (Suc n))"
      unfolding sum_integral_diff_series_def by (simp add: algebra_simps)
    also have "?int 0 n - ?int 0 (Suc n) = -?int n (Suc n)"
      by (subst integral_combine [symmetric, of "of_nat 0" "of_nat n" "of_nat (Suc n)"])
         (auto intro!: int simp: algebra_simps)
    also have "?int n (Suc n) \<ge> integral {of_nat n..of_nat (Suc n)} (\<lambda>_::real. f (of_nat (Suc n)))"
      by (intro integral_le int) (auto intro: dec)
    hence "f (of_nat (Suc n)) + -?int n (Suc n) \<le> 0" by (simp add: algebra_simps)
    finally show "sum_integral_diff_series (Suc n) \<le> sum_integral_diff_series n" by simp
  qed
  with assms show ?thesis
    by (induction rule: inc_induct) (auto intro: order.trans[OF _ d_mono])
qed

lemma sum_integral_diff_series_Bseq: "Bseq sum_integral_diff_series"
proof -
  from sum_integral_diff_series_nonneg and sum_integral_diff_series_antimono
    have "norm (sum_integral_diff_series n) \<le> sum_integral_diff_series 0" for n by simp
  thus "Bseq sum_integral_diff_series" by (rule BseqI')
qed

lemma sum_integral_diff_series_monoseq: "monoseq sum_integral_diff_series"
  using sum_integral_diff_series_antimono unfolding monoseq_def by blast

lemma sum_integral_diff_series_convergent: "convergent sum_integral_diff_series"
  using sum_integral_diff_series_Bseq sum_integral_diff_series_monoseq
  by (blast intro!: Bseq_monoseq_convergent)

lemma integral_test:
  "summable (\<lambda>n. f (of_nat n)) \<longleftrightarrow> convergent (\<lambda>n. integral {0..of_nat n} f)"
proof -
  have "summable (\<lambda>n. f (of_nat n)) \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))"
    by (simp add: summable_iff_convergent')
  also have "... \<longleftrightarrow> convergent (\<lambda>n. integral {0..of_nat n} f)"
  proof
    assume "convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))"
    from convergent_diff[OF this sum_integral_diff_series_convergent]
      show "convergent (\<lambda>n. integral {0..of_nat n} f)"
        unfolding sum_integral_diff_series_def by simp
  next
    assume "convergent (\<lambda>n. integral {0..of_nat n} f)"
    from convergent_add[OF this sum_integral_diff_series_convergent]
      show "convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))" unfolding sum_integral_diff_series_def by simp
  qed
  finally show ?thesis by simp
qed

end

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, opaque_lifting) 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