theory LTE
  imports
    "HOL-Number_Theory.Number_Theory"
begin

section "Library additions"

lemma cong_sum_mono_neutral_right:
  assumes "finite T"
  assumes "S \<subseteq> T"
  assumes zeros: "\<forall>i \<in> T - S. [g i = 0] (mod n)"
  shows "[sum g T = sum g S] (mod n)"
proof -
  have "[sum g T = (\<Sum>x\<in>T. if x \<in> S then g x else 0)] (mod n)"
    using zeros by (auto intro: cong_sum)
  also have "(\<Sum>x\<in>T. if x \<in> S then g x else 0) = (\<Sum>x\<in>S. if x \<in> S then g x else 0)"
    by (intro sum.mono_neutral_right; fact?; auto)
  also have "... = sum g S"
    by (auto intro: sum.cong)
  finally show ?thesis.
qed

lemma power_odd_inj:
  fixes a b :: "'a::linordered_idom"
  assumes "odd k" and "a^k = b^k"
  shows "a = b"
proof (cases "a \<ge> 0")
  case True
  then have "b \<ge> 0"
    using assms zero_le_odd_power by metis
  moreover from `odd k` have "k > 0" by presburger
  show ?thesis
    by (rule power_eq_imp_eq_base; fact)
next
  case False
  then have "b < 0"
    using assms power_less_zero_eq not_less by metis
  from `a^k = b^k` have "(-a)^k = (-b)^k"
    using `odd k` power_minus_odd by simp
  moreover have "-a \<ge> 0" and "-b \<ge> 0"
    using `\<not> a \<ge> 0` and `b < 0` by auto
  moreover from `odd k` have "k > 0" by presburger
  ultimately have "-a = -b" by (rule power_eq_imp_eq_base)
  then show ?thesis by simp
qed

lemma power_eq_abs:
  fixes a b :: "'a::linordered_idom"
  assumes "a^k = b^k" and "k > 0"
  shows "\<bar>a\<bar> = \<bar>b\<bar>"
proof -
  from `a^k = b^k` have "\<bar>a\<bar>^k = \<bar>b\<bar>^k"
    using power_abs by metis
  show "\<bar>a\<bar> = \<bar>b\<bar>"
    by (rule power_eq_imp_eq_base; fact?; auto)
qed

lemma cong_scale:
  "k \<noteq> 0 \<Longrightarrow> [a = b] (mod c) \<longleftrightarrow> [k*a = k*b] (mod k*c)"
  unfolding cong_def by auto

lemma odd_square_mod_4:
  fixes x :: int
  assumes "odd x"
  shows "[x^2 = 1] (mod 4)"
proof -
  have "x^2 - 1 = (x - 1) * (x + 1)"
    by (simp add: ring_distribs power2_eq_square)
  moreover from `odd x` have "2 dvd x - 1" and "2 dvd x + 1"
    by auto
  ultimately have "4 dvd x^2 - 1"
    by fastforce
  thus ?thesis
    by (simp add: cong_iff_dvd_diff)
qed

section \<open>The \<open>p > 2\<close> case\<close>

context
  fixes x y :: int and p :: nat
  assumes "prime p"
  assumes "p dvd x - y"
  assumes "\<not>p dvd x"   "\<not>p dvd y"
begin

lemma decompose_mod_p:
  "[(\<Sum>i<n. y^(n - Suc i) * x^i) = n*x^(n-1)] (mod p)"
proof -
  {
    fix i
    assume "i < n"
    from `p dvd x - y` have "[x = y] (mod p)"
      by (simp add: cong_iff_dvd_diff)
    hence "[y^(n - Suc i) * x^i = x^(n - Suc i) * x^i] (mod p)"
      by (intro cong_scalar_right cong_pow; rule cong_sym)
    also have "x^(n - Suc i) * x^i = x^(n - 1)"
      using `i < n` by (simp flip: power_add)
    finally have "[y^(n - Suc i) * x^i = x^(n - 1)] (mod p)"
      by auto
  }
  hence "[(\<Sum>i<n. y^(n - Suc i) * x^i) = (\<Sum>i<n. x^(n-1))] (mod p)"
    by (intro cong_sum; auto)
  thus "[(\<Sum>i<n. y^(n - Suc i) * x^i) = n * x^(n-1)] (mod p)"
    by simp
qed

text \<open>Lemma 1:\<close>

lemma multiplicity_diff_pow_coprime:
  assumes "coprime p n"
  shows "multiplicity p (x^n - y^n) = multiplicity p (x - y)"
proof -
  have factor: "x^n - y^n = (\<Sum>i<n. y^(n - Suc i) * x^i) * (x - y)"
    by (simp add: power_diff_sumr2)
  moreover have "\<not> p dvd (\<Sum>i<n. y^(n - Suc i) * x^i)"
  proof
    assume "p dvd (\<Sum>i<n. y^(n - Suc i) * x^i)"
    with decompose_mod_p have "p dvd n * x^(n-1)"
      using cong_dvd_iff by blast
    with `prime p` have "p dvd n \<or> p dvd x^(n-1)"
      by (simp add: prime_dvd_mult_eq_int)
    moreover from `coprime p n` and `prime p` have "\<not>p dvd n"
      using coprime_absorb_right not_prime_unit by auto
    ultimately have "p dvd x^(n-1)"
      by simp
    hence "p dvd x"
      using `prime p` prime_dvd_power_int prime_nat_int_transfer by blast
    with `\<not>p dvd x` show False by simp
  qed
  ultimately show "multiplicity p (x^n - y^n) = multiplicity p (x - y)"
    using `prime p`
    by (auto intro: multiplicity_prime_elem_times_other)
qed

text \<open>The inductive step:\<close>

lemma multiplicity_diff_self_pow:
  assumes "p > 2" and "x \<noteq> y"
  shows "multiplicity p (x^p - y^p) = Suc (multiplicity p (x - y))"
proof -
  have *: "multiplicity p (\<Sum>i<p. y^(p - Suc i) * x^i) = 1"
  proof (rule multiplicity_eqI)
    have "[(\<Sum>t<p. y^(p - Suc t) * x^t) = p * x^(p-1)] (mod p)"
      by (rule decompose_mod_p)
    also have "[p * x^(p-1) = 0] (mod p)"
      by (simp add: cong_mult_self_left)
    finally show "(int p)^1 dvd (\<Sum>i<p. y^(p - Suc i) * x^i)"
      by (simp add: cong_0_iff)

    from `p dvd x - y` obtain k::int where kp: "x = y + k * p"
      by (metis add.commute diff_add_cancel dvd_def mult.commute)

    have "[y^(p - Suc t) * x^t = y^(p-1) + t*k*p*y^(p-2)] (mod p^2)" if "t < p" for t
    proof (cases "t = 0")
      case False
      have "y^(p - Suc t) * x^t = y^(p - Suc t) * (y + k*p)^t"
        unfolding kp..
      also have "... = y^(p - Suc t) * (\<Sum>i\<le>t. (t choose i) * (k*p)^i * y^(t-i))"
        by (simp flip: binomial_ring add: add.commute)
      also have "[... = y^(p - Suc t) * (\<Sum>i\<le>1. (t choose i) * (k*p)^i * y^(t-i))] (mod p^2)"
        \<comment> \<open>discard \<open>i > 1\<close>\<close>
      proof (intro cong_scalar_left cong_sum_mono_neutral_right; rule)
        fix i
        assume "i \<in> {..t} - {..1}"
        then have "i \<ge> 2" by simp
        then obtain i' where "i = i' + 2"
          using add.commute le_Suc_ex by blast
        hence "(k*p)^i = (k*p)^i' * k^2 * p^2"
          by (simp add: ac_simps power2_eq_square)
        hence "[(k*p)^i = 0] (mod p^2)"
          by (simp add: cong_mult_self_right)
        thus "[(t choose i) * (k*p)^i * y^(t-i) = 0] (mod p^2)"
          by (simp add: cong_0_iff)
      qed (use `t \<noteq> 0` in auto)
      also have "(\<Sum>i\<le>1. (t choose i) * (k*p)^i * y^(t-i)) = y^t + t*k*p*y^(t-1)"
        by simp
      also have "y^(p - Suc t) * ... = y^(p-1) + t*k*p*y^(p-2)"
        using `t < p` `t \<noteq> 0` by (auto simp add: algebra_simps numeral_eq_Suc simp flip: power_add)
      finally show ?thesis.
    qed simp

    hence "[(\<Sum>t<p. y^(p - Suc t) * x^t) = (\<Sum>t<p. y^(p-1) + t*k*p*y^(p-2))] (mod p^2)"
      by (auto intro: cong_sum)
    also have "(\<Sum>t<p. y^(p-1) + t*k*p*y^(p-2)) = p*y^(p-1) + (\<Sum>t<p. t) * k*p*y^(p-2)"
      by (simp add: sum.distrib sum_distrib_right)
    also have "(\<Sum>t<p. t) = p*(p - 1) div 2"
      by (simp add: Sum_Ico_nat lessThan_atLeast0)
    finally have "[(\<Sum>t<p. y^(p - Suc t) * x^t) = p*y^(p-1) + (p*(p - 1) div 2) * k*p*y^(p-2)] (mod p^2)".
    moreover have "[(p*(p - 1) div 2) * k*p*y^(p-2) = 0] (mod p^2)"
    proof -
      have "[(p * (p - 1) div 2) * p = 0] (mod p^2)"
      proof -
        from `p > 2` and `prime p` have "odd p"
          using prime_odd_nat by blast
        thus ?thesis
          by (metis (no_types, lifting) cong_0_iff div_mult_swap dvd_times_left_cancel_iff
              dvd_triv_left le_0_eq linorder_not_less mult.commute odd_pos odd_two_times_div_two_nat
              one_add_one power_add power_one_right)
      qed
      hence "[int ((p*(p - 1) div 2) * p)*k*y^(p-2) = 0] (mod p^2)"
        unfolding cong_0_iff using int_dvd_int_iff by fastforce
      thus ?thesis
        by (simp add: ac_simps)
    qed
    ultimately have "[(\<Sum>t<p. y^(p - Suc t) * x^t) = p*y^(p-1)] (mod p^2)"
      by (smt cong_add cong_iff_dvd_diff)
    moreover have "\<not> p^2 dvd p*y^(p-1)"
      using `p > 2` `prime p` `\<not> p dvd y` by (simp add: power2_eq_square prime_dvd_power_int_iff)
    ultimately show "\<not> int p^(Suc 1) dvd (\<Sum>t<p. y^(p - Suc t) * x^t)"
      by (metis (no_types, lifting) Suc_1 of_nat_power cong_dvd_iff)
  qed
  moreover have "multiplicity p (x^p - y^p) = multiplicity p (x - y) + multiplicity p (\<Sum>i<p. y^(p - Suc i) * x^i)"
    apply (unfold power_diff_sumr2, intro prime_elem_multiplicity_mult_distrib)
    using `prime p` `x \<noteq> y` multiplicity_zero * by auto
  ultimately show ?thesis by simp
qed

text \<open>Theorem 1:\<close>

theorem multiplicity_diff_pow:
  assumes "p > 2" and "x \<noteq> y" and "n > 0"
  shows "multiplicity p (x^n - y^n) = multiplicity p (x - y) + multiplicity p n"
proof -
  obtain k where n: "n = p^multiplicity p n * k" and "\<not> p dvd k"
    using `n > 0` `prime p`
    by (metis neq0_conv not_prime_unit multiplicity_decompose')
  have "multiplicity p (x^(p^a * k) - y^(p^a * k)) = multiplicity p (x - y) + a" for a
  proof (induction a)
    case 0
    from `\<not> p dvd k` have "coprime p k"
      using `prime p` by (intro prime_imp_coprime)
    thus ?case
      by (simp add: multiplicity_diff_pow_coprime)
  next
    case (Suc a)
    let ?x' = "x^(p^a*k)" and ?y' = "y^(p^a*k)"
    have "\<not> p dvd ?x'" and "\<not> p dvd ?y'"
      using `\<not> p dvd x`  `\<not> p dvd y` and `prime p`
      by (meson prime_dvd_power prime_nat_int_transfer)+
    moreover have "p dvd ?x' - ?y'"
      using `p dvd x - y` by (simp add: power_diff_sumr2)
    moreover have "?x' \<noteq> ?y'"
    proof
      assume "?x' = ?y'"
      moreover have "0 < p^a * k"
        using `prime p` `n > 0` n
        by (metis gr0I mult_is_0 power_not_zero prime_gt_0_nat)
      ultimately have "\<bar>x\<bar> = \<bar>y\<bar>"
        by (intro power_eq_abs)
      with `x \<noteq> y` have "x = -y"
        using abs_eq_iff by simp
      with `p dvd x - y` have "p dvd 2*x"
        by simp
      with `prime p` have "p dvd 2 \<or> p dvd x"
        by (metis int_dvd_int_iff of_nat_numeral prime_dvd_mult_iff prime_nat_int_transfer)
      with `p > 2` have "p dvd x"
        by auto
      with `\<not> p dvd x` show False..
    qed
    moreover have "p^Suc a * k = p^a * k * p"
      by (simp add: ac_simps)
    ultimately show ?case
      using LTE.multiplicity_diff_self_pow[where x="?x'" and y="?y'", OF `prime p`] `p > 2`
        and Suc.IH
      by (metis add_Suc_right power_mult)
  qed
  with n show ?thesis by metis
qed

end

text \<open>Theorem 2:\<close>

corollary multiplicity_add_pow:
  fixes x y :: int and p n :: nat
  assumes "odd n"
    and "prime p" and "p > 2"
    and "p dvd x + y" and "\<not> p dvd x"  "\<not> p dvd y"
    and "x \<noteq> -y"
  shows "multiplicity p (x^n + y^n) = multiplicity p (x + y) + multiplicity p n"
proof -
  have [simp]: "(-y)^n = -(y^n)"
    using `odd n` by (rule power_minus_odd)
  moreover have "n > 0"
    using `odd n` by presburger
  with assms show ?thesis
    using multiplicity_diff_pow[where x=x and y="-y" and n=n]
    by simp
qed

section \<open>The \<open>p = 2\<close> case\<close>

text \<open>Theorem 3:\<close>

theorem multiplicity_2_diff_pow_4div:
  fixes x y :: int
  assumes "odd x"  "odd y" and "4 dvd x - y" and "n > 0"  "x \<noteq> y"
  shows "multiplicity 2 (x^n - y^n) = multiplicity 2 (x - y) + multiplicity 2 n"
proof -
  have "prime (2::nat)" by simp
  then obtain k where n: "n = 2^multiplicity 2 n * k" and "\<not> 2 dvd k"
    using `n > 0`
    by (metis neq0_conv not_prime_unit multiplicity_decompose')

  have pow2: "multiplicity 2 (x^(2^k) - y^(2^k)) = multiplicity 2 (x - y) + k" for k
  proof (induction k)
    case (Suc k)
    have "x^(2^Suc k) - y^(2^Suc k) = (x^2^k)^2 - (y^2^k)^2"
      by (simp flip: power_mult algebra_simps)
    also have "... = (x^2^k - y^2^k)*(x^2^k + y^2^k)"
      by (simp add: power2_eq_square algebra_simps)
    finally have factor: "x^(2^Suc k) - y^(2^Suc k) = (x^2^k - y^2^k)*(x^2^k + y^2^k)".
    moreover have m_plus: "multiplicity 2 (x^2^k + y^2^k) = 1"
    proof (rule multiplicity_eqI)
      show "2^1 dvd x^2^k + y^2^k"
        using `odd x` and `odd y` by simp

      have "[x^2^k + y^2^k = 2] (mod 4)"
      proof (cases k)
        case 0
        from `odd y` have "[y = 1] (mod 2)"
          using cong_def by fastforce
        hence "[2*y = 2] (mod 4)"
          using cong_scale[where k=2 and b=1 and c=2, simplified] by force
        moreover from `4 dvd x - y` have "[x - y = 0] (mod 4)"
          by (simp add: cong_0_iff)
        ultimately have "[x + y = 2] (mod 4)"
          by (smt cong_add)
        with `k = 0` show ?thesis by simp
      next
        case (Suc k')
        then have "[x^2^k = 1] (mod 4)" and "[y^2^k = 1] (mod 4)"
          using `odd x` `odd y`
          by (auto simp add: power_mult power_Suc2 simp del: power_Suc intro: odd_square_mod_4)
        thus "[x^2^k + y^2^k = 2] (mod 4)"
          by (smt cong_add)
      qed
      thus "\<not> 2^Suc 1 dvd x^2^k + y^2^k"
        by (simp add: cong_dvd_iff)
    qed
    moreover have "x^2^k + y^2^k \<noteq> 0"
      using m_plus multiplicity_zero by auto
    moreover have "x^2^k - y^2^k \<noteq> 0"
    proof
      assume "x^2^k - y^2^k = 0"
      then have "\<bar>x\<bar> = \<bar>y\<bar>"
        by (intro power_eq_abs, simp, simp)
      hence "x = y \<or> x = -y"
        using abs_eq_iff by auto
      with `x \<noteq> y` have "x = -y"
        by simp
      with `4 dvd x - y` have "4 dvd 2*x"
        by simp
      hence "2 dvd x"
        by auto
      with `odd x` show False..
    qed
    ultimately have "multiplicity 2 (x^2^Suc k - y^2^Suc k) =
            multiplicity 2 (x^2^k - y^2^k) + multiplicity 2 (x^2^k + y^2^k)"
      by (unfold factor; intro prime_elem_multiplicity_mult_distrib; auto)
    then show ?case
      using m_plus Suc.IH by simp
  qed simp

  moreover have even_diff: "int 2 dvd x^2^multiplicity 2 n - y^2^multiplicity 2 n"
    using `odd x` and `odd y` by simp
  moreover have odd_parts: "\<not> int 2 dvd x^2^multiplicity 2 n"   "\<not> int 2 dvd y^2^multiplicity 2 n"
    using `odd x` and `odd y` by simp+
  moreover have coprime: "coprime 2 k"
    using `\<not> 2 dvd k` by simp

  show ?thesis
    apply (subst (1) n)
    apply (subst (2) n)
    apply (simp only: power_mult)
    apply (simp only: multiplicity_diff_pow_coprime[OF `prime 2` even_diff odd_parts coprime, simplified])
    by (rule pow2)
qed

text \<open>Theorem 4:\<close>

theorem multiplicity_2_diff_even_pow:
  fixes x y :: int
  assumes "odd x"  "odd y" and "even n" and "n > 0" and "\<bar>x\<bar> \<noteq> \<bar>y\<bar>"
  shows "multiplicity 2 (x^n - y^n) = multiplicity 2 (x - y) + multiplicity 2 (x + y) + multiplicity 2 n - 1"
proof -
  obtain n' where "n = 2*n'"
    using `even n` by auto
  with `n > 0` have "n' > 0" by simp

  moreover have "4 dvd x^2 - y^2"
  proof -
    have "x^2 - y^2 = (x + y) * (x - y)"
      by (simp add: algebra_simps power2_eq_square)
    moreover have "2 dvd x + y" and "2 dvd x - y"
      using `odd x` and `odd y` by auto
    ultimately show "4 dvd x^2 - y^2" by fastforce
  qed

  moreover have "odd (x^2)" and "odd (y^2)"
    using `odd x` `odd y` by auto
  moreover from `\<bar>x\<bar> \<noteq> \<bar>y\<bar>` have "x^2 \<noteq> y^2"
    using diff_0 diff_0_right power2_eq_iff by fastforce

  ultimately have "multiplicity 2 ((x^2)^n' - (y^2)^n') = multiplicity 2 (x^2 - y^2) + multiplicity 2 n'"
    by (intro multiplicity_2_diff_pow_4div)
  also have "multiplicity 2 ((x^2)^n' - (y^2)^n') = multiplicity 2 (x^n - y^n)"
    unfolding `n = 2*n'` by (simp add: power_mult)
  also have "multiplicity 2 (x^2 - y^2) = multiplicity 2 ((x - y) * (x + y))"
    by (simp add: algebra_simps power2_eq_square)
  also have "... = multiplicity 2 (x - y) + multiplicity 2 (x + y)"
    using `\<bar>x\<bar> \<noteq> \<bar>y\<bar>` by (auto intro: prime_elem_multiplicity_mult_distrib)
  also have "multiplicity 2 n = Suc (multiplicity 2 n')"
    unfolding `n = 2*n'` using `n' > 0` by (simp add: multiplicity_times_same)
  ultimately show ?thesis by simp
qed

end


section\<open>Lattice Orderd Groups\<close>

(*
    Author: Viorel Preoteasa
*)

theory Lattice_Ordered_Group
imports Modular_Distrib_Lattice
begin

text\<open>
This theory introduces lattice ordered groups \<^cite>\<open>"birkhoff:1942"\<close>
and proves some results about them. The most important result is
that a lattice ordered group is also a distributive lattice.
\<close>

class lgroup = group_add + lattice +
assumes add_order_preserving: "a \<le> b \<Longrightarrow> u + a + v \<le> u + b + v"
begin

lemma add_order_preserving_left: "a \<le> b \<Longrightarrow> u + a \<le> u + b"
  apply (cut_tac a = a and b = b and u = u and v = 0 in add_order_preserving)
  by simp_all

lemma add_order_preserving_right: "a \<le> b \<Longrightarrow> a + v \<le> b + v"
  apply (cut_tac a = a and b = b and u = 0 and v = v in add_order_preserving)
  by simp_all

lemma minus_order: "-a \<le> -b \<Longrightarrow> b \<le> a"
  apply (cut_tac a = "-a" and b = "-b" and u = a and v = b in add_order_preserving)
  by simp_all

lemma right_move_to_left: "a + - c \<le> b \<Longrightarrow> a \<le> b + c"
  apply (drule_tac v = "c" in add_order_preserving_right)
  by (simp add: add.assoc)

lemma right_move_to_right: "a \<le> b + -c \<Longrightarrow> a + c \<le> b"
  apply (drule_tac v = "c" in add_order_preserving_right)
  by (simp add: add.assoc)

lemma [simp]: "(a \<sqinter> b) - c = (a - c) \<sqinter> (b - c)"
  by (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)

lemma left_move_to_left: "-c + a \<le> b \<Longrightarrow> a \<le> c + b"
  apply (drule_tac u = "c" in add_order_preserving_left)
  by (simp add: add.assoc [THEN sym])

lemma left_move_to_right: "a \<le> - c + b \<Longrightarrow> c + a \<le> b"
  apply (drule_tac u = "c" in add_order_preserving_left)
  by (simp add: add.assoc [THEN sym])

lemma [simp]: "c + (a \<sqinter> b) = (c + a) \<sqinter> (c + b)"
  apply (rule order.antisym)
  apply simp
  apply safe
  apply (rule add_order_preserving_left)
  apply simp
  apply (rule add_order_preserving_left)
  apply simp
  apply (rule left_move_to_left)
  apply simp
  apply safe
  apply (rule left_move_to_right)
  apply simp
  apply (rule left_move_to_right)
  by simp

lemma [simp]: "- (a \<sqinter> b) = (- a) \<squnion> (- b)"
  apply (rule order.antisym)
  apply (rule minus_order)
  apply simp
  apply safe
  apply (rule minus_order)
  apply simp
  apply (rule minus_order)
  apply simp
  apply simp
  apply safe
  apply (rule minus_order)
  apply simp
  apply (rule minus_order)
  by simp

lemma [simp]: "(a \<squnion> b) + c = (a + c) \<squnion> (b + c)"
  apply (rule order.antisym)
  apply (rule right_move_to_right)
  apply simp
  apply safe
  apply (simp_all only: diff_conv_add_uminus)
  apply (rule right_move_to_left)
  apply simp
  apply (rule right_move_to_left)
  apply simp
  apply simp
  apply safe
  apply (rule add_order_preserving_right)
  apply simp
  apply (rule add_order_preserving_right)
  by simp

lemma [simp]: "c + (a \<squnion> b) = (c + a) \<squnion> (c + b)"
  apply (rule order.antisym)
  apply (rule left_move_to_right)
  apply simp
  apply safe
  apply (rule left_move_to_left)
  apply simp
  apply (rule left_move_to_left)
  apply simp
  apply simp
  apply safe
  apply (rule add_order_preserving_left)
  apply simp
  apply (rule add_order_preserving_left)
  by simp

lemma [simp]: "c - (a \<sqinter> b) = (c - a) \<squnion> (c - b)"
  by (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)

lemma [simp]: "(a \<squnion> b) - c = (a - c) \<squnion>  (b - c)"
  by (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)

lemma [simp]: "- (a \<squnion> b) = (- a) \<sqinter> (- b)"
  apply (rule order.antisym)
  apply simp
  apply safe
  apply (rule minus_order)
  apply simp
  apply (rule minus_order)
  apply simp
  apply (rule minus_order)
  by simp

lemma [simp]: "c - (a \<squnion> b) = (c - a) \<sqinter> (c - b)"
  by (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)

lemma add_pos: "0 \<le> a \<Longrightarrow> b \<le> b + a"
  apply (cut_tac a = 0 and b = a and u = b and v = 0 in add_order_preserving)
  by simp_all

lemma add_pos_left: "0 \<le> a \<Longrightarrow> b \<le> a + b"
  apply (rule right_move_to_left)
  by simp

lemma inf_sup: "a - (a \<sqinter> b) + b = a \<squnion> b"
  by (simp add: add.assoc sup_commute)

lemma inf_sup_2: "b = (a \<sqinter> b) - a + (a \<squnion> b)"
  apply (unfold inf_sup [THEN sym])
  proof -
    fix a b:: 'a
    have "b = (a \<sqinter> b) + (- a + a) + - (a \<sqinter> b) + b" by (simp only: right_minus left_minus add_0_right add_0_left)
    also have "\<dots> = (a \<sqinter> b) + - a + (a + - (a \<sqinter> b) + b)" by (unfold add.assoc, simp)
    also have "\<dots> = (a \<sqinter> b) - a + (a - (a \<sqinter> b) + b)" by simp
    finally show "b = (a \<sqinter> b) - a + (a - (a \<sqinter> b) + b)" .
  qed

subclass inf_sup_eq_lattice
  proof
    fix x y z:: 'a
    assume A: "x \<sqinter> z = y \<sqinter> z"
    assume B: "x \<squnion> z = y \<squnion> z"
    have "x = (z \<sqinter> x) - z + (z \<squnion> x)" by (rule inf_sup_2)
    also have "\<dots> = (z \<sqinter> y) - z + (z \<squnion> y)" by (simp add: sup_commute inf_commute A B)
    also have "\<dots> = y" by (simp only: inf_sup_2 [THEN sym])
    finally show "x = y" .
  qed
end

end


(*  Title:       ODEs and Dynamical Systems for HS verification
    Maintainer:  Jonathan Julián Huerta y Munive <jonjulian23@gmail.com>
*)

section \<open> Ordinary Differential Equations \<close>

text \<open>Vector fields @{text "f::real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector)"} represent systems
of ordinary differential equations (ODEs). Picard-Lindeloef's theorem guarantees existence
and uniqueness of local solutions to initial value problems involving Lipschitz continuous
vector fields. A (local) flow @{text "\<phi>::real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector)"} for such
a system is the function that maps initial conditions to their unique solutions. In dynamical
systems, the set of all points @{text "\<phi> t s::'a"} for a fixed @{text "s::'a"} is the flow's
orbit. If the orbit of each @{text "s \<in> I"} is conatined in @{text I}, then @{text I} is an
invariant set of this system. This section formalises these concepts with a focus on hybrid
systems (HS) verification.\<close>

theory Dynamical_Systems
  imports "HS_Preliminaries"
begin

subsection \<open> Initial value problems and orbits \<close>

notation image ("\<P>")

lemma image_le_pred[simp]: "(\<P> f A \<subseteq> {s. G s}) = (\<forall>x\<in>A. G (f x))"
  unfolding image_def by force

definition ivp_sols :: "('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow> (real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector))
  \<Rightarrow> real \<Rightarrow> 'a \<Rightarrow> (real \<Rightarrow> 'a) set" ("Sols")
  where "Sols U S f t\<^sub>0 s = {X \<in> U s \<rightarrow> S. (D X = (\<lambda>t. f t (X t)) on U s) \<and> X t\<^sub>0 = s \<and> t\<^sub>0 \<in> U s}"

lemma ivp_solsI:
  assumes "D X = (\<lambda>t. f t (X t)) on U s" and "X t\<^sub>0 = s"
      and "X \<in> U s \<rightarrow> S" and "t\<^sub>0 \<in> U s"
    shows "X \<in> Sols U S f t\<^sub>0 s"
  using assms unfolding ivp_sols_def by blast

lemma ivp_solsD:
  assumes "X \<in> Sols U S f t\<^sub>0 s"
  shows "D X = (\<lambda>t. f t (X t)) on U s" and "X t\<^sub>0 = s"
    and "X \<in> U s \<rightarrow> S" and "t\<^sub>0 \<in> U s"
  using assms unfolding ivp_sols_def by auto

lemma in_ivp_sols_subset:
  "t\<^sub>0 \<in> (U s) \<Longrightarrow> (U s) \<subseteq> (T s) \<Longrightarrow> X \<in> Sols T S f t\<^sub>0 s \<Longrightarrow> X \<in> Sols U S f t\<^sub>0 s "
  apply(rule ivp_solsI)
  using ivp_solsD(1,2) has_vderiv_on_subset
     apply blast+
  by (drule ivp_solsD(3)) auto

abbreviation "down U t \<equiv> {\<tau> \<in> U. \<tau> \<le> t}"

definition g_orbit :: "(('a::ord) \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'b set" ("\<gamma>")
  where "\<gamma> X G U = \<Union>{\<P> X (down U t) |t. \<P> X (down U t) \<subseteq> {s. G s}}"

lemma g_orbit_eq:
  fixes X::"('a::preorder) \<Rightarrow> 'b"
  shows "\<gamma> X G U = {X t |t. t \<in> U \<and> (\<forall>\<tau>\<in>down U t. G (X \<tau>))}"
  unfolding g_orbit_def using order_trans by auto blast

definition g_orbital :: "(real \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow>
  ('a::real_normed_vector) \<Rightarrow> 'a set"
  where "g_orbital f G U S t\<^sub>0 s = \<Union>{\<gamma> X G (U s) |X. X \<in> Sols U S f t\<^sub>0 s}"

lemma g_orbital_eq: "g_orbital f G U S t\<^sub>0 s =
  {X t |t X. t \<in> U s \<and> \<P> X (down (U s) t) \<subseteq> {s. G s} \<and> X \<in> Sols U S f t\<^sub>0 s }"
  unfolding g_orbital_def ivp_sols_def g_orbit_eq by auto

lemma g_orbitalI:
  assumes "X \<in> Sols U S f t\<^sub>0 s"
    and "t \<in> U s" and "(\<P> X (down (U s) t) \<subseteq> {s. G s})"
  shows "X t \<in> g_orbital f G U S t\<^sub>0 s"
  using assms unfolding g_orbital_eq(1) by auto

lemma g_orbitalD:
  assumes "s' \<in> g_orbital f G U S t\<^sub>0 s"
  obtains X and t where "X \<in> Sols U S f t\<^sub>0 s"
  and "X t = s'" and "t \<in> U s" and "(\<P> X (down (U s) t) \<subseteq> {s. G s})"
  using assms unfolding g_orbital_def g_orbit_eq by auto

lemma "g_orbital f G U S t\<^sub>0 s = {X t |t X. X t \<in> \<gamma> X G (U s) \<and> X \<in> Sols U S f t\<^sub>0 s}"
  unfolding g_orbital_eq g_orbit_eq by auto

lemma "X \<in> Sols U S f t\<^sub>0 s \<Longrightarrow> \<gamma> X G (U s) \<subseteq> g_orbital f G U S t\<^sub>0 s"
  unfolding g_orbital_eq g_orbit_eq by auto

lemma "g_orbital f G U S t\<^sub>0 s \<subseteq> g_orbital f (\<lambda>s. True) U S t\<^sub>0 s"
  unfolding g_orbital_eq by auto

lemma "\<nu> \<in> g_orbital f G (\<lambda>s. {t. t \<ge> 0}) S t\<^sub>0 \<omega> \<longleftrightarrow>
  (\<exists>X\<in>Sols (\<lambda>s. {t. t \<ge> 0}) S f t\<^sub>0 \<omega>. \<exists>t\<ge>0. X t = \<nu> \<and> (\<forall>\<tau>\<in>{0..t}. G (X \<tau>)))"
  apply(simp add: g_orbital_eq, rule iffI)
   apply(clarsimp, rule_tac x=X in bexI, rule_tac x=t in exI, simp_all)
  by (clarsimp, rule_tac x=t in exI, rule_tac x=X in exI, simp_all)

no_notation g_orbit ("\<gamma>")

subsection \<open> Differential Invariants \<close>

definition diff_inv :: "('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> bool)
  \<Rightarrow> (real \<Rightarrow> ('a::real_normed_vector) \<Rightarrow> 'a) \<Rightarrow> real \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
  where "diff_inv U S G f t\<^sub>0 I \<equiv> (\<Union> \<circ> (\<P> (g_orbital f G U S t\<^sub>0))) {s. I s} \<subseteq> {s. I s}"

lemma diff_inv_eq: "diff_inv U S G f t\<^sub>0 I =
  (\<forall>s. I s \<longrightarrow> (\<forall>X\<in>Sols U S f t\<^sub>0 s. (\<forall>t\<in>U s.(\<forall>\<tau>\<in>(down (U s) t). G (X \<tau>)) \<longrightarrow> I (X t))))"
  unfolding diff_inv_def g_orbital_eq image_le_pred by auto

lemma diff_inv_eq_inv_set:
  "diff_inv U S G f t\<^sub>0 I = (\<forall>s. I s \<longrightarrow> (g_orbital f G U S t\<^sub>0 s) \<subseteq> {s. I s})"
  unfolding diff_inv_eq g_orbital_eq image_le_pred by auto

lemma "diff_inv U S (\<lambda>s. True) f t\<^sub>0 I \<Longrightarrow> diff_inv U S G f t\<^sub>0 I"
  unfolding diff_inv_eq by auto

named_theorems diff_inv_rules "rules for certifying differential invariants"

(* changing dom of derivation to down (U (X t\<^sub>0)) t makes this rule imply the lens version *)
lemma diff_inv_eq0I:
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> 'b::real_inner"
  assumes ivl: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and dX: "\<And>X t. D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U (X t\<^sub>0) \<Longrightarrow> \<forall>\<tau>\<in>(down (U (X t\<^sub>0)) t). G (X \<tau>)
    \<Longrightarrow> D (\<lambda>\<tau>. \<mu> (X \<tau>)) = (\<lambda>\<tau>. \<tau> *\<^sub>R 0) on U (X t\<^sub>0)"
  shows "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<mu> s = 0)"
proof(clarsimp simp: diff_inv_eq ivp_sols_def)
  fix X t
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "\<mu> (X t\<^sub>0) = 0"
    and G_hyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
    and set_hyps: "t\<^sub>0 \<in> U (X t\<^sub>0)" "t \<in> U (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  hence sub_ivl: "{t\<^sub>0<--<t} \<subseteq> U (X t\<^sub>0)" "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)"
    using ivl[of "X t\<^sub>0"]
    by (meson PiE closed_segment_subset_interval segment_open_subset_closed subset_trans)
      (metis Pi_mem ivl closed_segment_subset_interval set_hyps)
  hence key: "D (\<lambda>\<tau>. \<mu> (X \<tau>)) = (\<lambda>\<tau>. \<tau> *\<^sub>R 0) on {t\<^sub>0--t}"
    using has_vderiv_on_subset[OF dX[of X, OF xivp(1)] sub_ivl(2)] G_hyp
    by blast
  hence "\<forall>\<tau>\<in>{t\<^sub>0<--<t}. D (\<lambda>\<tau>. \<mu> (X \<tau>)) \<mapsto> (\<lambda>t. 0) (at \<tau>)"
    using has_vderiv_on_subset[OF key segment_open_subset_closed, unfolded has_vderiv_on_iff]
    at_within_open[OF _ open_real_segment, of _ t\<^sub>0 t] by auto
  moreover note mvt_ivl_general[OF _ vderiv_on_continuous_on[OF key], of "\<lambda>\<tau> t. 0"]
  ultimately have "t\<^sub>0 \<noteq> t \<Longrightarrow> \<parallel>\<mu> (X t)\<parallel> = 0"
    using xivp by auto
  thus "\<mu> (X t) = 0"
    using xivp by auto
qed

lemma diff_inv_eqI [diff_inv_rules]:
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> 'b::real_inner"
  assumes "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and "\<And>X t. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> \<forall>\<tau>\<in>(down (U(X t\<^sub>0)) t). G (X \<tau>)
    \<Longrightarrow> D (\<lambda>\<tau>. \<mu> (X \<tau>) - \<nu> (X \<tau>)) = (\<lambda>\<tau>. \<tau> *\<^sub>R 0) on U(X t\<^sub>0)"
  shows "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<mu> s = \<nu> s)"
  using diff_inv_eq0I[where \<mu>="\<lambda>s. \<mu> s - \<nu> s"] assms by auto

text \<open> can this be generalised to @{term "\<mu>::'a::real_normed_vector \<Rightarrow> 'b::real_inner"}? \<close>
lemma
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  assumes ivl: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and dX: "\<And>X t. D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0) \<Longrightarrow> \<forall>\<tau>\<in>(down (U(X t\<^sub>0)) t). G (X \<tau>)
    \<Longrightarrow> (D (\<lambda>\<tau>. \<mu> (X \<tau>)) = (\<lambda>\<tau>. \<mu>' (X \<tau>)) on U(X t\<^sub>0))
      \<and> (\<forall>\<tau>\<in>{t\<^sub>0<--<t}. (\<tau> > t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<ge> 0) \<and> (\<tau> < t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<le> 0))"
  shows diff_inv_leq0I: "diff_inv U S G f t\<^sub>0 (\<lambda>s. 0 \<le> \<mu> s) "
    and diff_inv_less0I: "diff_inv U S G f t\<^sub>0 (\<lambda>s. 0 < \<mu> s)"
proof(auto simp: diff_inv_eq ivp_sols_def)
  fix X t
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)"
    and G_hyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
    and set_hyps: "t\<^sub>0 \<in> U (X t\<^sub>0)" "t \<in> U (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  hence sub_ivl: "{t\<^sub>0<--<t} \<subseteq> U (X t\<^sub>0)" "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)"
    using ivl[of "X t\<^sub>0"]
    by (meson PiE closed_segment_subset_interval segment_open_subset_closed subset_trans)
      (metis Pi_mem ivl closed_segment_subset_interval set_hyps)
  hence key: "D (\<lambda>\<tau>. \<mu> (X \<tau>)) = (\<lambda>\<tau>. \<mu>' (X \<tau>)) on {t\<^sub>0--t}"
    using G_hyp has_vderiv_on_subset[OF conjunct1[OF dX[of X, OF xivp(1)]]]
    by auto
  {assume "t\<^sub>0 \<noteq> t"
    then obtain \<tau> where mvt: "\<mu> (X t) = (t - t\<^sub>0) * \<mu>' (X \<tau>) + \<mu> (X t\<^sub>0)" and "\<tau> \<in> {t\<^sub>0<--<t}"
      using mvt_simple_closed_segmentE[OF key]
      by (metis diff_add_cancel)
    hence "t\<^sub>0 < t \<Longrightarrow> t\<^sub>0 < \<tau>" and "t\<^sub>0 > t \<Longrightarrow> t\<^sub>0 > \<tau>"
      unfolding open_segment_eq_real_ivl
      by auto
    hence "t\<^sub>0 < t \<Longrightarrow> 0 \<le> \<mu>' (X \<tau>)" and "t < t\<^sub>0 \<Longrightarrow> \<mu>' (X \<tau>) \<le> 0"
      using conjunct2[OF dX[OF xivp(1) _ ]] G_hyp \<open>\<tau> \<in> {t\<^sub>0<--<t}\<close>
      by auto
    hence "(0 < \<mu> (X t\<^sub>0) \<longrightarrow> \<mu> (X t) > 0) \<and> (0 \<le> \<mu> (X t\<^sub>0) \<longrightarrow> 0 \<le> \<mu> (X t))"
      using mvt \<open>t\<^sub>0 \<noteq> t\<close> mult_nonneg_nonneg mult_neg_neg
      by (metis add_nonneg_nonneg diff_gt_0_iff_gt le_add_same_cancel2
          less_eq_real_def linorder_not_le mult_eq_0_iff)}
  thus "0 < \<mu> (X t\<^sub>0) \<Longrightarrow> 0 < \<mu> (X t)"
    and "0 \<le> \<mu> (X t\<^sub>0) \<Longrightarrow> 0 \<le> \<mu> (X t)"
    by blast+
qed

lemma
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  assumes ivl: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and dX: "\<And>X t. D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0) \<Longrightarrow> \<forall>\<tau>\<in>(down (U(X t\<^sub>0)) t). G (X \<tau>)
    \<Longrightarrow> (D (\<lambda>\<tau>. \<mu>(X \<tau>) - \<nu>(X \<tau>)) = (\<lambda>\<tau>. \<mu>'(X \<tau>) - \<nu>'(X \<tau>)) on U (X t\<^sub>0)) \<and>
    (\<forall>\<tau>\<in>{t\<^sub>0<--<t}. (\<tau> > t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>)) \<and> (\<tau> < t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>)))"
  shows diff_inv_leqI [diff_inv_rules]: "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s \<le> \<mu> s) "
    and diff_inv_lessI [diff_inv_rules]: "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s < \<mu> s)"
  using diff_inv_less0I[where \<mu>="\<lambda>s. \<mu> s - \<nu> s" and \<mu>'="\<lambda>s. \<mu>' s - \<nu>' s"] assms
  diff_inv_leq0I[where \<mu>="\<lambda>s. \<mu> s - \<nu> s" and \<mu>'="\<lambda>s. \<mu>' s - \<nu>' s"] by auto

lemma diff_inv_nleq_iff:
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  shows "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<not> \<nu> s \<le> \<mu> s) \<longleftrightarrow> diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s > \<mu> s)"
  unfolding approximation_preproc_push_neg(2) by presburger

lemma diff_inv_neqI [diff_inv_rules]:
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  assumes "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s < \<mu> s)"
    and "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s > \<mu> s)"
  shows "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s \<noteq> \<mu> s)"
proof(unfold diff_inv_eq, clarsimp)
  fix s::'a and X::"real \<Rightarrow> 'a" and t::real
  assume "\<nu> s \<noteq> \<mu> s" and Xhyp: "X \<in> Sols U S f t\<^sub>0 s"
     and thyp: "t \<in> U s" and Ghyp: "\<forall>\<tau>. \<tau> \<in> U s \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  hence "\<nu> s < \<mu> s \<or> \<nu> s > \<mu> s"
    by linarith
  moreover have "\<nu> s < \<mu> s \<Longrightarrow> \<nu> (X t) < \<mu> (X t)"
    using assms(1) Xhyp thyp Ghyp unfolding diff_inv_eq by auto
  moreover have "\<nu> s > \<mu> s \<Longrightarrow> \<nu> (X t) > \<mu> (X t)"
    using assms(2) Xhyp thyp Ghyp unfolding diff_inv_eq by auto
  ultimately show "\<nu> (X t) = \<mu> (X t) \<Longrightarrow> False"
    by auto
qed

lemma diff_inv_neqE:
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)" "\<And>s t. s \<in> S \<Longrightarrow> t \<in> U s \<Longrightarrow> t\<^sub>0 \<le> t"
    and conts: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> continuous_on (\<P> X (U (X t\<^sub>0))) \<nu>"
      "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> continuous_on (\<P> X (U (X t\<^sub>0))) \<mu>"
    and dI:"diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s \<noteq> \<mu> s)"
  shows "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s < \<mu> s)"
proof(unfold diff_inv_eq ivp_sols_def, clarsimp)
  fix X t assume Ghyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  assume tHyp: "t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence "t\<^sub>0 \<le> t" and "\<mu> (X t) \<noteq> \<nu> (X t)"
    using xivp(3) Uhyp(2) apply force
    using dI tHyp xivp(2) Ghyp ivp_solsI[of X f U "X t\<^sub>0", OF xivp(1) _ xivp(3) t0Hyp]
    unfolding diff_inv_eq by force
  moreover
  {assume ineq2:"\<nu> (X t) > \<mu> (X t)"
    note continuous_on_compose[OF vderiv_on_continuous_on[OF xivp(1)]]
    hence "continuous_on (U (X t\<^sub>0)) (\<nu> \<circ> X)" and "continuous_on (U (X t\<^sub>0)) (\<mu> \<circ> X)"
      using xivp(1) conts by blast+
    also have "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)"
      using closed_segment_subset_interval[OF Uhyp(1) t0Hyp tHyp] xivp(3) t0Hyp by auto
    ultimately have "continuous_on {t\<^sub>0--t} (\<lambda>\<tau>. \<nu> (X \<tau>))"
      and "continuous_on {t\<^sub>0--t} (\<lambda>\<tau>. \<mu> (X \<tau>))"
      using continuous_on_subset by auto
    then obtain \<tau> where "\<tau> \<in> {t\<^sub>0--t}" "\<mu> (X \<tau>) = \<nu> (X \<tau>)"
      using IVT_two_functions_real_ivl[OF _ _ xivp(2) ineq2] by force
    hence "\<forall>r\<in>down (U (X t\<^sub>0)) \<tau>. G (X r)" and "\<tau> \<in> U (X t\<^sub>0)"
      using Ghyp \<open>\<tau> \<in> {t\<^sub>0--t}\<close> \<open>t\<^sub>0 \<le> t\<close> \<open>{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)\<close>
      by (auto simp: closed_segment_eq_real_ivl)
    hence "\<mu> (X \<tau>) \<noteq> \<nu> (X \<tau>)"
      using dI tHyp xivp(2) ivp_solsI[of X f U "X t\<^sub>0", OF xivp(1) _ xivp(3) t0Hyp]
      unfolding diff_inv_eq by force
    hence "False"
      using \<open>\<mu> (X \<tau>) = \<nu> (X \<tau>)\<close> by blast}
  ultimately show "\<nu> (X t) < \<mu> (X t)"
    by fastforce
qed

lemma
  assumes "diff_inv U S G f t\<^sub>0 I\<^sub>1"
    and "diff_inv U S G f t\<^sub>0 I\<^sub>2"
  shows diff_inv_conjI [diff_inv_rules]: "diff_inv U S G f t\<^sub>0 (\<lambda>s. I\<^sub>1 s \<and> I\<^sub>2 s)"
    and diff_inv_disjI [diff_inv_rules]: "diff_inv U S G f t\<^sub>0 (\<lambda>s. I\<^sub>1 s \<or> I\<^sub>2 s)"
  using assms unfolding diff_inv_def by auto

lemma
  fixes \<mu>::"'a::real_normed_vector \<Rightarrow> real"
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and Gg: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> > t\<^sub>0 \<longrightarrow> G (X \<tau>) \<longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>))"
    and Gl: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> < t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>))"
    and dX: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> D (\<lambda>\<tau>. \<mu>(X \<tau>)-\<nu>(X \<tau>)) = (\<lambda>\<tau>. \<mu>'(X \<tau>)-\<nu>'(X \<tau>)) on U(X t\<^sub>0)"
  shows diff_inv_leq_alt: "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s \<le> \<mu> s)"
    and diff_inv_less_alt: "diff_inv U S G f t\<^sub>0 (\<lambda>s. \<nu> s < \<mu> s)"
proof(simp_all add: diff_inv_eq ivp_sols_def, safe)
  fix X t assume Ghyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  assume tHyp: "t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence obs1: "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)" "{t\<^sub>0<--<t} \<subseteq> U (X t\<^sub>0)"
    using closed_segment_subset_interval[OF Uhyp t0Hyp tHyp] xivp(2) segment_open_subset_closed
    by (force, metis PiE \<open>X t\<^sub>0 \<in> S \<Longrightarrow> {t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)\<close> dual_order.trans)
  hence obs2: "D (\<lambda>\<tau>. \<mu> (X \<tau>) - \<nu> (X \<tau>)) = (\<lambda>\<tau>. \<mu>' (X \<tau>) - \<nu>' (X \<tau>)) on {t\<^sub>0--t}"
    using has_vderiv_on_subset[OF dX[OF xivp(1)]] by auto
  {assume "t \<noteq> t\<^sub>0"
    then obtain r where rHyp: "r \<in> {t\<^sub>0<--<t}"
      and "(\<mu>(X t)-\<nu>(X t)) - (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) = (\<lambda>\<tau>. \<tau>*(\<mu>'(X r)-\<nu>'(X r))) (t - t\<^sub>0)"
      using mvt_simple_closed_segmentE obs2 by blast
    hence mvt: "\<mu>(X t)-\<nu>(X t) = (t - t\<^sub>0)*(\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0))"
      by force
    have primed: "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> > t\<^sub>0 \<Longrightarrow> G (X \<tau>) \<Longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>)"
      "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> < t\<^sub>0 \<Longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>)"
      using Gg[OF xivp(1)] Gl[OF xivp(1)] by auto
    have "t > t\<^sub>0 \<Longrightarrow> r > t\<^sub>0 \<and> G (X r)" "\<not> t\<^sub>0 \<le> t \<Longrightarrow> r < t\<^sub>0" "r \<in> U (X t\<^sub>0)"
      using \<open>r \<in> {t\<^sub>0<--<t}\<close> obs1 Ghyp
      unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl by auto
    moreover have "r > t\<^sub>0 \<Longrightarrow> G (X r) \<Longrightarrow> (\<mu>'(X r)- \<nu>'(X r)) \<ge> 0" "r < t\<^sub>0 \<Longrightarrow> (\<mu>'(X r)-\<nu>'(X r)) \<le> 0"
      using primed(1,2)[OF \<open>r \<in> U (X t\<^sub>0)\<close>] by auto
    ultimately have "(t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) \<ge> 0"
      by (case_tac "t \<ge> t\<^sub>0", force, auto simp: split_mult_pos_le)
    hence "\<nu> (X t\<^sub>0) \<le> \<mu> (X t\<^sub>0) \<Longrightarrow> (t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) \<ge> 0"
      and "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0) \<Longrightarrow> (t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) > 0"
      using xivp(2) by auto
    hence "\<nu> (X t\<^sub>0) \<le> \<mu> (X t\<^sub>0) \<Longrightarrow> \<nu> (X t) \<le> \<mu> (X t)"
      and "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0) \<Longrightarrow> \<nu> (X t) < \<mu> (X t)"
      using mvt by simp_all}
  thus "\<nu> (X t\<^sub>0) \<le> \<mu> (X t\<^sub>0) \<Longrightarrow> \<nu> (X t) \<le> \<mu> (X t)"
    and "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0) \<Longrightarrow> \<nu> (X t) < \<mu> (X t)"
    using xivp by blast+
qed

subsection \<open> Picard-Lindeloef \<close>

text\<open> A locale with the assumptions of Picard-Lindeloef's theorem. It extends
@{term "ll_on_open_it"} by providing an initial time @{term "t\<^sub>0 \<in> T"}.\<close>

locale picard_lindeloef =
  fixes f::"real \<Rightarrow> ('a::{heine_borel,banach}) \<Rightarrow> 'a" and T::"real set" and S::"'a set" and t\<^sub>0::real
  assumes open_domain: "open T" "open S"
    and interval_time: "is_interval T"
    and init_time: "t\<^sub>0 \<in> T"
    and cont_vec_field: "\<forall>s \<in> S. continuous_on T (\<lambda>t. f t s)"
    and lipschitz_vec_field: "local_lipschitz T S f"
begin

sublocale ll_on_open_it T f S t\<^sub>0
  by (unfold_locales) (auto simp: cont_vec_field lipschitz_vec_field interval_time open_domain)

lemma ll_on_open: "ll_on_open T f S"
  using local.general.ll_on_open_axioms .

lemmas subintervalI = closed_segment_subset_domain
   and init_time_ex_ivl = existence_ivl_initial_time[OF init_time]
   and flow_at_init[simp] = general.flow_initial_time[OF init_time]

abbreviation "ex_ivl s \<equiv> existence_ivl t\<^sub>0 s"

lemma flow_has_vderiv_on_ex_ivl:
  assumes "s \<in> S"
  shows "D flow t\<^sub>0 s = (\<lambda>t. f t (flow t\<^sub>0 s t)) on ex_ivl s"
  using flow_usolves_ode[OF init_time \<open>s \<in> S\<close>]
  unfolding usolves_ode_from_def solves_ode_def by blast

lemma flow_funcset_ex_ivl:
  assumes "s \<in> S"
  shows "flow t\<^sub>0 s \<in> ex_ivl s \<rightarrow> S"
  using flow_usolves_ode[OF init_time \<open>s \<in> S\<close>]
  unfolding usolves_ode_from_def solves_ode_def by blast

lemma flow_in_ivp_sols_ex_ivl:
  assumes "s \<in> S"
  shows "flow t\<^sub>0 s \<in> Sols (\<lambda>s. ex_ivl s) S f t\<^sub>0 s"
  using flow_has_vderiv_on_ex_ivl[OF assms] apply(rule ivp_solsI)
    apply(simp_all add: init_time assms)
  by (rule flow_funcset_ex_ivl[OF assms])

lemma csols_eq: "csols t\<^sub>0 s = {(x, t). t \<in> T \<and>  x \<in> Sols (\<lambda>s. {t\<^sub>0--t}) S f t\<^sub>0 s}"
  unfolding ivp_sols_def csols_def solves_ode_def
  using closed_segment_subset_domain init_time by auto

lemma subset_ex_ivlI:
  "Y\<^sub>1 \<in> Sols (\<lambda>s. T) S f t\<^sub>0 s \<Longrightarrow> {t\<^sub>0--t} \<subseteq> T \<Longrightarrow> A \<subseteq> {t\<^sub>0--t} \<Longrightarrow> A \<subseteq> ex_ivl s"
  apply(clarsimp simp: existence_ivl_def)
  apply(subgoal_tac "t\<^sub>0 \<in> T", clarsimp simp: csols_eq)
   apply(rule_tac x=Y\<^sub>1 in exI, rule_tac x=t in exI, safe, force)
  by (rule in_ivp_sols_subset[where T="\<lambda>s. T"], auto)

lemma unique_solution: \<comment> \<open> proved for a subset of T for general applications \<close>
  assumes "s \<in> S" and "t\<^sub>0 \<in> U" and "t \<in> U"
    and "is_interval U" and "U \<subseteq> ex_ivl s"
    and xivp: "D Y\<^sub>1 = (\<lambda>t. f t (Y\<^sub>1 t)) on U" "Y\<^sub>1 t\<^sub>0 = s" "Y\<^sub>1 \<in> U \<rightarrow> S"
    and yivp: "D Y\<^sub>2 = (\<lambda>t. f t (Y\<^sub>2 t)) on U" "Y\<^sub>2 t\<^sub>0 = s" "Y\<^sub>2 \<in> U \<rightarrow> S"
  shows "Y\<^sub>1 t = Y\<^sub>2 t"
proof-
  have "t\<^sub>0 \<in> T"
    using assms existence_ivl_subset by auto
  have key: "(flow t\<^sub>0 s usolves_ode f from t\<^sub>0) (ex_ivl s) S"
    using flow_usolves_ode[OF \<open>t\<^sub>0 \<in> T\<close> \<open>s \<in> S\<close>] .
  hence "\<forall>t\<in>U. Y\<^sub>1 t = flow t\<^sub>0 s t"
    unfolding usolves_ode_from_def solves_ode_def apply safe
    by (erule_tac x=Y\<^sub>1 in allE, erule_tac x=U in allE, auto simp: assms)
  also have "\<forall>t\<in>U. Y\<^sub>2 t = flow t\<^sub>0 s t"
    using key unfolding usolves_ode_from_def solves_ode_def apply safe
    by (erule_tac x=Y\<^sub>2 in allE, erule_tac x=U in allE, auto simp: assms)
  ultimately show "Y\<^sub>1 t = Y\<^sub>2 t"
    using assms by auto
qed

text \<open>Applications of lemma @{text "unique_solution"}: \<close>

lemma unique_solution_closed_ivl:
  assumes xivp: "D X = (\<lambda>t. f t (X t)) on {t\<^sub>0--t}" "X t\<^sub>0 = s" "X \<in> {t\<^sub>0--t} \<rightarrow> S" and "t \<in> T"
    and yivp: "D Y = (\<lambda>t. f t (Y t)) on {t\<^sub>0--t}" "Y t\<^sub>0 = s" "Y \<in> {t\<^sub>0--t} \<rightarrow> S" and "s \<in> S"
  shows "X t = Y t"
  apply(rule unique_solution[OF \<open>s \<in> S\<close>, of "{t\<^sub>0--t}"], simp_all add: assms)
  apply(unfold existence_ivl_def csols_eq ivp_sols_def, clarsimp)
  using xivp \<open>t \<in> T\<close> by blast

lemma solution_eq_flow:
  assumes xivp: "D X = (\<lambda>t. f t (X t)) on ex_ivl s" "X t\<^sub>0 = s" "X \<in> ex_ivl s \<rightarrow> S"
    and "t \<in> ex_ivl s" and "s \<in> S"
  shows "X t = flow t\<^sub>0 s t"
  apply(rule unique_solution[OF \<open>s \<in> S\<close> init_time_ex_ivl \<open>t \<in> ex_ivl s\<close>])
  using flow_has_vderiv_on_ex_ivl flow_funcset_ex_ivl \<open>s \<in> S\<close> by (auto simp: assms)

lemma ivp_unique_solution:
  assumes "s \<in> S" and ivl: "is_interval (U s)" and "U s \<subseteq> T" and "t \<in> U s"
    and ivp1: "Y\<^sub>1 \<in> Sols U S f t\<^sub>0 s" and ivp2: "Y\<^sub>2 \<in> Sols U S f t\<^sub>0 s"
  shows "Y\<^sub>1 t = Y\<^sub>2 t"
proof(rule unique_solution[OF \<open>s \<in> S\<close>, of "{t\<^sub>0--t}"], simp_all)
  have "t\<^sub>0 \<in> U s"
    using ivp_solsD[OF ivp1] by auto
  hence obs0: "{t\<^sub>0--t} \<subseteq> U s"
    using closed_segment_subset_interval[OF ivl] \<open>t \<in> U s\<close> by blast
  moreover have obs1: "Y\<^sub>1 \<in> Sols (\<lambda>s. {t\<^sub>0--t}) S f t\<^sub>0 s"
    by (rule in_ivp_sols_subset[OF _ calculation(1) ivp1], simp)
  moreover have obs2: "Y\<^sub>2 \<in> Sols (\<lambda>s. {t\<^sub>0--t}) S f t\<^sub>0 s"
    by (rule in_ivp_sols_subset[OF _ calculation(1) ivp2], simp)
  ultimately show "{t\<^sub>0--t} \<subseteq> ex_ivl s"
    apply(unfold existence_ivl_def csols_eq, clarsimp)
    apply(rule_tac x=Y\<^sub>1 in exI, rule_tac x=t in exI)
    using \<open>t \<in> U s\<close> and \<open>U s \<subseteq> T\<close> by force
  show "D Y\<^sub>1 = (\<lambda>t. f t (Y\<^sub>1 t)) on {t\<^sub>0--t}"
    by (rule ivp_solsD[OF in_ivp_sols_subset[OF _ _ ivp1]], simp_all add: obs0)
  show "D Y\<^sub>2 = (\<lambda>t. f t (Y\<^sub>2 t)) on {t\<^sub>0--t}"
    by (rule ivp_solsD[OF in_ivp_sols_subset[OF _ _ ivp2]], simp_all add: obs0)
  show "Y\<^sub>1 t\<^sub>0 = s" and "Y\<^sub>2 t\<^sub>0 = s"
    using ivp_solsD[OF ivp1] ivp_solsD[OF ivp2] by auto
  show "Y\<^sub>1 \<in> {t\<^sub>0--t} \<rightarrow> S" and "Y\<^sub>2 \<in> {t\<^sub>0--t} \<rightarrow> S"
    using ivp_solsD[OF obs1] ivp_solsD[OF obs2] by auto
qed

lemma g_orbital_orbit:
  assumes "s \<in> S" and ivl: "is_interval (U s)" and "U s \<subseteq> T"
    and ivp: "Y \<in> Sols U S f t\<^sub>0 s"
  shows "g_orbital f G U S t\<^sub>0 s = g_orbit Y G (U s)"
proof-
  have eq1: "\<forall>Z \<in> Sols U S f t\<^sub>0 s. \<forall>t\<in>U s. Z t = Y t"
    by (clarsimp, rule ivp_unique_solution[OF assms(1,2,3) _ _ ivp], auto)
  have "g_orbital f G U S t\<^sub>0 s \<subseteq> g_orbit (\<lambda>t. Y t) G (U s)"
  proof
    fix x assume "x \<in> g_orbital f G U S t\<^sub>0 s"
    then obtain Z and t
      where z_def: "x = Z t \<and> t \<in> U s \<and> (\<forall>\<tau>\<in>down (U s) t. G (Z \<tau>)) \<and> Z \<in> Sols U S f t\<^sub>0 s"
      unfolding g_orbital_eq by auto
    hence "{t\<^sub>0--t} \<subseteq> U s"
      using closed_segment_subset_interval[OF ivl ivp_solsD(4)[OF ivp]] by blast
    hence "\<forall>\<tau>\<in>{t\<^sub>0--t}. Z \<tau> = Y \<tau>"
      using z_def apply clarsimp
      by (rule ivp_unique_solution[OF assms(1,2,3) _ _ ivp], auto)
    thus "x \<in> g_orbit Y G (U s)"
      using z_def eq1 unfolding g_orbit_eq by simp metis
  qed
  moreover have "g_orbit Y G (U s) \<subseteq> g_orbital f G U S t\<^sub>0 s"
    apply(unfold g_orbital_eq g_orbit_eq ivp_sols_def, clarsimp)
    apply(rule_tac x=t in exI, rule_tac x=Y in exI)
    using ivp_solsD[OF ivp] by auto
  ultimately show ?thesis
    by blast
qed

end

lemma local_lipschitz_add:
  fixes f1 f2 :: "real \<Rightarrow> 'a::banach \<Rightarrow> 'a"
  assumes "local_lipschitz T S f1"
      and "local_lipschitz T S f2"
    shows "local_lipschitz T S (\<lambda>t s. f1 t s + f2 t s)"
proof(unfold local_lipschitz_def, clarsimp)
  fix s and t assume "s \<in> S" and "t \<in> T"
  obtain \<epsilon>\<^sub>1 L1 where "\<epsilon>\<^sub>1 > 0" and L1: "\<And>\<tau>. \<tau>\<in>cball t \<epsilon>\<^sub>1 \<inter> T \<Longrightarrow> L1-lipschitz_on (cball s \<epsilon>\<^sub>1 \<inter> S) (f1 \<tau>)"
    using local_lipschitzE[OF assms(1) \<open>t \<in> T\<close> \<open>s \<in> S\<close>] by blast
  obtain \<epsilon>\<^sub>2 L2 where "\<epsilon>\<^sub>2 > 0" and L2: "\<And>\<tau>. \<tau>\<in>cball t \<epsilon>\<^sub>2 \<inter> T \<Longrightarrow> L2-lipschitz_on (cball s \<epsilon>\<^sub>2 \<inter> S) (f2 \<tau>)"
    using local_lipschitzE[OF assms(2) \<open>t \<in> T\<close> \<open>s \<in> S\<close>] by blast
  have ballH: "cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S \<subseteq> cball s \<epsilon>\<^sub>1 \<inter> S" "cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S \<subseteq> cball s \<epsilon>\<^sub>2 \<inter> S"
    by auto
  have obs1: "\<forall>\<tau>\<in>cball t \<epsilon>\<^sub>1 \<inter> T. L1-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (f1 \<tau>)"
    using lipschitz_on_subset[OF L1 ballH(1)] by blast
  also have obs2: "\<forall>\<tau>\<in>cball t \<epsilon>\<^sub>2 \<inter> T. L2-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (f2 \<tau>)"
    using lipschitz_on_subset[OF L2 ballH(2)] by blast
  ultimately have "\<forall>\<tau>\<in>cball t (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> T.
    (L1 + L2)-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (\<lambda>s. f1 \<tau> s + f2 \<tau> s)"
    using lipschitz_on_add by fastforce
  thus "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on (cball s u \<inter> S) (\<lambda>s. f1 t s + f2 t s)"
    apply(rule_tac x="min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2" in exI)
    using \<open>\<epsilon>\<^sub>1 > 0\<close> \<open>\<epsilon>\<^sub>2 > 0\<close> by force
qed

lemma picard_lindeloef_add: "picard_lindeloef f1 T S t\<^sub>0 \<Longrightarrow> picard_lindeloef f2 T S t\<^sub>0 \<Longrightarrow>
  picard_lindeloef (\<lambda>t s. f1 t s + f2 t s) T S t\<^sub>0"
  unfolding picard_lindeloef_def apply(clarsimp, rule conjI)
  using continuous_on_add apply fastforce
  using local_lipschitz_add by blast

lemma picard_lindeloef_constant: "picard_lindeloef (\<lambda>t s. c) UNIV UNIV t\<^sub>0"
  apply(unfold_locales, simp_all add: local_lipschitz_def lipschitz_on_def, clarsimp)
  by (rule_tac x=1 in exI, clarsimp, rule_tac x="1/2" in exI, simp)

subsection \<open> Flows for ODEs \<close>

text\<open> A locale designed for verification of hybrid systems. The user can select the interval
of existence and the defining flow equation via the variables @{term "T"} and @{term "\<phi>"}.\<close>

locale local_flow = picard_lindeloef "(\<lambda> t. f)" T S 0
  for f::"'a::{heine_borel,banach} \<Rightarrow> 'a" and T S L +
  fixes \<phi> :: "real \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes ivp:
    "\<And> t s. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--t}"
    "\<And> s. s \<in> S \<Longrightarrow> \<phi> 0 s = s"
    "\<And> t s. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> (\<lambda>t. \<phi> t s) \<in> {0--t} \<rightarrow> S"
begin

lemma in_ivp_sols_ivl:
  assumes "t \<in> T" "s \<in> S"
  shows "(\<lambda>t. \<phi> t s) \<in> Sols (\<lambda>s. {0--t}) S (\<lambda>t. f) 0 s"
  apply(rule ivp_solsI)
  using ivp assms by auto

lemma eq_solution_ivl:
  assumes xivp: "D X = (\<lambda>t. f (X t)) on {0--t}" "X 0 = s" "X \<in> {0--t} \<rightarrow> S"
    and indom: "t \<in> T" "s \<in> S"
  shows "X t = \<phi> t s"
  apply(rule unique_solution_closed_ivl[OF xivp \<open>t \<in> T\<close>])
  using \<open>s \<in> S\<close> ivp indom by auto

lemma ex_ivl_eq:
  assumes "s \<in> S"
  shows "ex_ivl s = T"
  using existence_ivl_subset[of s] apply safe
  unfolding existence_ivl_def csols_eq
  using in_ivp_sols_ivl[OF _ assms] by blast

lemma has_derivative_on_open1:
  assumes  "t > 0" "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball t r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) \<open>t \<in> T\<close> by blast
  moreover have "t + r/2 > 0"
    using \<open>r > 0\<close> \<open>t > 0\<close> by auto
  moreover have "{0--t} \<subseteq> T"
    using subintervalI[OF init_time \<open>t \<in> T\<close>] .
  ultimately have subs: "{0<--<t + r/2} \<subseteq> T"
    unfolding abs_le_eq abs_le_eq real_ivl_eqs[OF \<open>t > 0\<close>] real_ivl_eqs[OF \<open>t + r/2 > 0\<close>]
    by clarify (case_tac "t < x", simp_all add: cball_def ball_def dist_norm subset_eq field_simps)
  have "t + r/2 \<in> T"
    using rHyp unfolding real_ivl_eqs[OF rHyp(1)] by (simp add: subset_eq)
  hence "{0--t + r/2} \<subseteq> T"
    using subintervalI[OF init_time] by blast
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(t + r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  hence vderiv: "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0<--<t + r/2})"
    apply(rule has_vderiv_on_subset)
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] by auto
  have "t \<in> {0<--<t + r/2}"
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] using rHyp \<open>t > 0\<close> by simp
  moreover have "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) (at t within {0<--<t + r/2})"
    using vderiv calculation unfolding has_vderiv_on_def has_vector_derivative_def by blast
  moreover have "open {0<--<t + r/2}"
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] by simp
  ultimately show ?thesis
    using subs that by blast
qed

lemma has_derivative_on_open2:
  assumes "t < 0" "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball t r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) \<open>t \<in> T\<close> by blast
  moreover have "t - r/2 < 0"
    using \<open>r > 0\<close> \<open>t < 0\<close> by auto
  moreover have "{0--t} \<subseteq> T"
    using subintervalI[OF init_time \<open>t \<in> T\<close>] .
  ultimately have subs: "{0<--<t - r/2} \<subseteq> T"
    unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl
      real_ivl_eqs[OF rHyp(1)] by(auto simp: subset_eq)
  have "t - r/2 \<in> T"
    using rHyp unfolding real_ivl_eqs by (simp add: subset_eq)
  hence "{0--t - r/2} \<subseteq> T"
    using subintervalI[OF init_time] by blast
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(t - r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  hence vderiv: "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0<--<t - r/2})"
    apply(rule has_vderiv_on_subset)
    unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl by auto
  have "t \<in> {0<--<t - r/2}"
    unfolding open_segment_eq_real_ivl using rHyp \<open>t < 0\<close> by simp
  moreover have "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) (at t within {0<--<t - r/2})"
    using vderiv calculation unfolding has_vderiv_on_def has_vector_derivative_def by blast
  moreover have "open {0<--<t - r/2}"
    unfolding open_segment_eq_real_ivl by simp
  ultimately show ?thesis
    using subs that by blast
qed

lemma has_derivative_on_open3:
  assumes "s \<in> S"
  obtains B where "0 \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> 0 s)) at 0 within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball 0 r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) init_time by blast
  hence "r/2 \<in> T" "-r/2 \<in> T" "r/2 > 0"
    unfolding real_ivl_eqs by auto
  hence subs: "{0--r/2} \<subseteq> T" "{0--(-r/2)} \<subseteq> T"
    using subintervalI[OF init_time] by auto
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--r/2})"
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(-r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  also have "{0--r/2} = {0--r/2} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)}"
    "{0--(-r/2)} = {0--(-r/2)} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)}"
    unfolding closed_segment_eq_real_ivl \<open>r/2 > 0\<close> by auto
  ultimately have vderivs:
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--r/2} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)})"
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(-r/2)} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)})"
    unfolding closed_segment_eq_real_ivl \<open>r/2 > 0\<close> by auto
  have obs: "0 \<in> {-r/2<--<r/2}"
    unfolding open_segment_eq_real_ivl using \<open>r/2 > 0\<close> by auto
  have union: "{-r/2--r/2} = {0--r/2} \<union> {0--(-r/2)}"
    unfolding closed_segment_eq_real_ivl by auto
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {-r/2--r/2})"
    using has_vderiv_on_union[OF vderivs] by simp
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {-r/2<--<r/2})"
    using has_vderiv_on_subset[OF _ segment_open_subset_closed[of "-r/2" "r/2"]] by auto
  hence "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> 0 s)) (at 0 within {-r/2<--<r/2})"
    unfolding has_vderiv_on_def has_vector_derivative_def using obs by blast
  moreover have "open {-r/2<--<r/2}"
    unfolding open_segment_eq_real_ivl by simp
  moreover have "{-r/2<--<r/2} \<subseteq> T"
    using subs union segment_open_subset_closed by blast
  ultimately show ?thesis
    using obs that by blast
qed

lemma has_derivative_on_open:
  assumes "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
  apply(subgoal_tac "t < 0 \<or> t = 0 \<or> t > 0")
  using has_derivative_on_open1[OF _ assms] has_derivative_on_open2[OF _ assms]
    has_derivative_on_open3[OF \<open>s \<in> S\<close>] by blast force

lemma in_domain:
  assumes "s \<in> S"
  shows "(\<lambda>t. \<phi> t s) \<in> T \<rightarrow> S"
  using ivp(3)[OF _ assms] by blast

lemma has_vderiv_on_domain:
  assumes "s \<in> S"
  shows "D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on T"
proof(unfold has_vderiv_on_def has_vector_derivative_def, clarsimp)
  fix t assume "t \<in> T"
  then obtain B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and Dhyp: "D (\<lambda>t. \<phi> t s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
    using assms has_derivative_on_open[OF \<open>t \<in> T\<close>] by blast
  hence "t \<in> interior B"
    using interior_eq by auto
  thus "D (\<lambda>t. \<phi> t s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within T"
    using has_derivative_at_within_mono[OF _ \<open>B \<subseteq> T\<close> Dhyp] by blast
qed

lemma in_ivp_sols:
  assumes "s \<in> S" and "0 \<in> U s" and "U s \<subseteq> T"
  shows "(\<lambda>t. \<phi> t s) \<in> Sols U S (\<lambda>t. f) 0 s"
  apply(rule in_ivp_sols_subset[OF _ _ ivp_solsI, of _ _ _ "\<lambda>s. T"])
  using  ivp(2)[OF \<open>s \<in> S\<close>] has_vderiv_on_domain[OF \<open>s \<in> S\<close>]
    in_domain[OF \<open>s \<in> S\<close>] assms by auto

lemma eq_solution:
  assumes "s \<in> S" and "is_interval (U s)" and "U s \<subseteq> T" and "t \<in> U s"
    and xivp: "X \<in> Sols U S (\<lambda>t. f) 0 s"
  shows "X t = \<phi> t s"
  apply(rule ivp_unique_solution[OF assms], rule in_ivp_sols)
  by (simp_all add: ivp_solsD(4)[OF xivp] assms)

lemma ivp_sols_collapse:
  assumes "T = UNIV" and "s \<in> S"
  shows "Sols (\<lambda>s. T) S (\<lambda>t. f) 0 s = {(\<lambda>t. \<phi> t s)}"
  apply (safe, simp_all add: fun_eq_iff, clarsimp)
   apply(rule eq_solution[of _ "\<lambda>s. T"]; simp add: assms)
  by (rule in_ivp_sols; simp add: assms)

lemma additive_in_ivp_sols:
  assumes "s \<in> S" and "\<P> (\<lambda>\<tau>. \<tau> + t) T \<subseteq> T"
  shows "(\<lambda>\<tau>. \<phi> (\<tau> + t) s) \<in> Sols (\<lambda>s. T) S (\<lambda>t. f) 0 (\<phi> (0 + t) s)"
  apply(rule ivp_solsI[OF vderiv_composeI])
       apply(rule has_vderiv_on_subset[OF has_vderiv_on_domain])
  using in_domain assms init_time by (auto intro!: vderiv_intros)

lemma is_monoid_action:
  assumes "s \<in> S" and "T = UNIV"
  shows "\<phi> 0 s = s" and "\<phi> (t\<^sub>1 + t\<^sub>2) s = \<phi> t\<^sub>1 (\<phi> t\<^sub>2 s)"
proof-
  show "\<phi> 0 s = s"
    using ivp assms by simp
  have "\<phi> (0 + t\<^sub>2) s = \<phi> t\<^sub>2 s"
    by simp
  also have "\<phi> (0 + t\<^sub>2) s \<in> S"
    using in_domain assms by auto
  ultimately show "\<phi> (t\<^sub>1 + t\<^sub>2) s = \<phi> t\<^sub>1 (\<phi> t\<^sub>2 s)"
    using eq_solution[OF _ _ _ _ additive_in_ivp_sols] assms by auto
qed

lemma g_orbital_collapses:
  assumes "s \<in> S" and "is_interval (U s)" and "U s \<subseteq> T" and "0 \<in> U s"
  shows "g_orbital (\<lambda>t. f) G U S 0 s = {\<phi> t s| t. t \<in> U s \<and> (\<forall>\<tau>\<in>down (U s) t. G (\<phi> \<tau> s))}"
  apply (subst g_orbital_orbit[of _ _ "\<lambda>t. \<phi> t s"], simp_all add: assms g_orbit_eq)
  by (rule in_ivp_sols, simp_all add: assms)

definition orbit :: "'a \<Rightarrow> 'a set" ("\<gamma>\<^sup>\<phi>")
  where "\<gamma>\<^sup>\<phi> s = g_orbital (\<lambda>t. f) (\<lambda>s. True) (\<lambda>s. T) S 0 s"

lemma orbit_eq:
  assumes "s \<in> S"
  shows "\<gamma>\<^sup>\<phi> s = {\<phi> t s| t. t \<in> T}"
  apply(unfold orbit_def, subst g_orbital_collapses)
  by (simp_all add: assms init_time interval_time)

lemma true_g_orbit_eq:
  assumes "s \<in> S"
  shows "g_orbit (\<lambda>t. \<phi> t s) (\<lambda>s. True) T = \<gamma>\<^sup>\<phi> s"
  unfolding g_orbit_eq orbit_eq[OF assms] by simp

end

lemma line_is_local_flow:
  "0 \<in> T \<Longrightarrow> is_interval T \<Longrightarrow> open T \<Longrightarrow> local_flow (\<lambda> s. c) T UNIV (\<lambda> t s. s + t *\<^sub>R c)"
  apply(unfold_locales, simp_all add: local_lipschitz_def lipschitz_on_def, clarsimp)
   apply(rule_tac x=1 in exI, clarsimp, rule_tac x="1/2" in exI, simp)
  apply(rule_tac f'1="\<lambda> s. 0" and g'1="\<lambda> s. c" in has_vderiv_on_add[THEN has_vderiv_on_eq_rhs])
    apply(rule derivative_intros, simp)+
  by simp_all

end


(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Cauchy's Root Bound\<close>

text \<open>This theory contains a formalization of Cauchy's root bound, i.e.,
  given an integer polynomial it determines a bound \<open>b\<close> such that all real or complex
  roots of the polynomials have a norm below \<open>b\<close>.\<close>

theory Cauchy_Root_Bound
imports
  Algebraic_Numbers_Pre_Impl
begin

hide_const (open) UnivPoly.coeff
hide_const (open) Module.smult

text \<open>Division of integers, rounding to the upper value.\<close>
definition div_ceiling :: "int \<Rightarrow> int \<Rightarrow> int" where
  "div_ceiling x y = (let q = x div y in if q * y = x then q else q + 1)"

definition root_bound :: "int poly \<Rightarrow> rat" where
  "root_bound p \<equiv> let
     n = degree p;
     m = 1 + div_ceiling (max_list_non_empty (map (\<lambda>i. abs (coeff p i)) [0..<n]))
          (abs (lead_coeff p))
     \<comment> \<open>round to the next higher number \<open>2^n\<close>, so that bisection will\<close>
     \<comment> \<open>stay on integers for as long as possible\<close>
   in of_int (2 ^ (log_ceiling 2 m))"

lemma root_imp_deg_nonzero: assumes "p \<noteq> 0" "poly p x = 0"
  shows "degree p \<noteq> 0"
proof
  assume "degree p = 0"
  from degree0_coeffs[OF this] assms show False by auto
qed

lemma cauchy_root_bound: fixes x :: "'a :: real_normed_field"
  assumes x: "poly p x = 0" and p: "p \<noteq> 0"
  shows "norm x \<le> 1 + max_list_non_empty (map (\<lambda> i. norm (coeff p i)) [0 ..< degree p])
    / norm (lead_coeff p)" (is "_ \<le> _ + ?max / ?nlc")
proof -
  let ?n = "degree p"
  let ?p = "coeff p"
  let ?lc = "lead_coeff p"
  define ml where "ml = ?max / ?nlc"
  from p have lc: "?lc \<noteq> 0" by auto
  hence nlc: "norm ?lc > 0" by auto
  from root_imp_deg_nonzero[OF p x] have *: "0 \<in> set [0 ..< degree p]" by auto
  have "0 \<le> norm (?p 0)" by simp
  also have "\<dots> \<le> ?max"
    by (rule max_list_non_empty, insert *, auto)
  finally have max0: "?max \<ge> 0" .
  with nlc have ml0: "ml \<ge> 0" unfolding ml_def by auto
  hence easy: "norm x \<le> 1 \<Longrightarrow> ?thesis" unfolding ml_def[symmetric] by auto
  show ?thesis
  proof (cases "norm x \<le> 1")
    case True
    thus ?thesis using easy by auto
  next
    case False
    hence nx: "norm x > 1" by simp
    hence x0: "x \<noteq> 0" by auto
    hence xn0: "0 < norm x ^ ?n" by auto
    from x[unfolded poly_altdef] have "x ^ ?n * ?lc = x ^ ?n * ?lc - (\<Sum>i\<le>?n. x ^ i * ?p i)"
      unfolding poly_altdef by (simp add: ac_simps)
    also have "(\<Sum>i\<le>?n. x ^ i * ?p i) = x ^ ?n * ?lc + (\<Sum>i < ?n. x ^ i * ?p i)"
      by (subst sum.remove[of _ ?n], auto intro: sum.cong)
    finally have "x ^ ?n * ?lc = - (\<Sum>i < ?n. x ^ i * ?p i)" by simp
    with lc have "x ^ ?n = - (\<Sum>i < ?n. x ^ i * ?p i) / ?lc" by (simp add: field_simps)
    from arg_cong[OF this, of norm]
    have "norm x ^ ?n = norm ((\<Sum>i < ?n. x ^ i * ?p i) / ?lc)" unfolding norm_power by simp
    also have "(\<Sum>i < ?n. x ^ i * ?p i) / ?lc = (\<Sum>i < ?n. x ^ i * ?p i / ?lc)"
      by (rule sum_divide_distrib)
    also have "norm \<dots> \<le> (\<Sum>i < ?n. norm (x ^ i * (?p i / ?lc)))"
      by (simp add: field_simps, rule norm_sum)
    also have "\<dots> = (\<Sum>i < ?n. norm x ^ i * norm (?p i / ?lc))"
      unfolding norm_mult norm_power ..
    also have "\<dots> \<le> (\<Sum>i < ?n. norm x ^ i * ml)"
    proof (rule sum_mono)
      fix i
      assume "i \<in> {..<?n}"
      hence i: "i < ?n" by simp
      show "norm x ^ i * norm (?p i / ?lc) \<le> norm x ^ i * ml"
      proof (rule mult_left_mono)
        show "0 \<le> norm x ^ i" using nx by auto
        show "norm (?p i / ?lc) \<le> ml" unfolding norm_divide ml_def
          by (rule divide_right_mono[OF max_list_non_empty], insert nlc i, auto)
      qed
    qed
    also have "\<dots> = ml * (\<Sum>i < ?n. norm x ^ i)"
      unfolding sum_distrib_right[symmetric] by simp
    also have "(\<Sum>i < ?n. norm x ^ i) = (norm x ^ ?n - 1) / (norm x - 1)"
      by (rule geometric_sum, insert nx, auto)
    finally have "norm x ^ ?n \<le> ml * (norm x ^ ?n - 1) / (norm x - 1)" by simp
    from mult_left_mono[OF this, of "norm x - 1"]
    have "(norm x - 1) * (norm x ^ ?n) \<le> ml * (norm x ^ ?n - 1)" using nx by auto
    also have "\<dots> = (ml * (1 - 1 / (norm x ^ ?n))) * norm x ^ ?n"
      using nx False x0 by (simp add: field_simps)
    finally have "(norm x - 1) * (norm x ^ ?n) \<le> (ml * (1 - 1 / (norm x ^ ?n))) * norm x ^ ?n" .
    from mult_right_le_imp_le[OF this xn0]
    have "norm x - 1 \<le> ml * (1 - 1 / (norm x ^ ?n))" by simp
    hence "norm x \<le> 1 + ml - ml / (norm x ^ ?n)" by (simp add: field_simps)
    also have "\<dots> \<le> 1 + ml" using ml0 xn0 by auto
    finally show ?thesis unfolding ml_def .
  qed
qed

lemma div_le_div_ceiling: "x div y \<le> div_ceiling x y"
  unfolding div_ceiling_def Let_def by auto

lemma div_ceiling: assumes q: "q \<noteq> 0"
  shows "(of_int x :: 'a :: floor_ceiling) / of_int q \<le> of_int (div_ceiling x q)"
proof (cases "q dvd x")
  case True
  then obtain k where xqk: "x = q * k" unfolding dvd_def by auto
  hence id: "div_ceiling x q = k" unfolding div_ceiling_def Let_def using q by auto
  show ?thesis unfolding id unfolding xqk using q by simp
next
  case False
  {
    assume "x div q * q = x"
    hence "x = q * (x div q)" by (simp add: ac_simps)
    hence "q dvd x" unfolding dvd_def by auto
    with False have False by simp
  }
  hence id: "div_ceiling x q = x div q + 1"
    unfolding div_ceiling_def Let_def using q by auto
  show ?thesis unfolding id
    by (metis floor_divide_of_int_eq le_less add1_zle_eq floor_less_iff)
qed

lemma max_list_non_empty_map: assumes hom: "\<And> x y. max (f x) (f y) = f (max x y)"
  shows "xs \<noteq> [] \<Longrightarrow> max_list_non_empty (map f xs) = f (max_list_non_empty xs)"
  by (induct xs rule: max_list_non_empty.induct, auto simp: hom)

lemma root_bound: assumes "root_bound p = B" and deg: "degree p > 0"
  shows "ipoly p (x :: 'a :: real_normed_field) = 0 \<Longrightarrow> norm x \<le> of_rat B" "B \<ge> 0"
proof -
  let ?r = "of_rat :: _ \<Rightarrow> 'a"
  let ?i = "of_int :: _ \<Rightarrow> 'a"
  let ?p = "map_poly ?i p"
  define n where "n = degree p"
  let ?lc = "coeff p n"
  let ?list = "map (\<lambda>i. abs (coeff p i)) [0..<n]"
  let ?list' = "(map (\<lambda>i. real_of_int (abs ((coeff p i)))) [0..<n])"
  define m where "m = max_list_non_empty ?list"
  define m_up where "m_up = 1 + div_ceiling m (abs ?lc)"
  define C where "C = rat_of_int (2^(log_ceiling 2 m_up))"
  from deg have p0: "p \<noteq> 0" by auto
  from p0 have alc0: "abs ?lc \<noteq> 0" unfolding n_def by auto
  from deg have mem: "abs (coeff p 0) \<in> set ?list" unfolding n_def by auto
  from max_list_non_empty[OF this, folded m_def]
  have m0: "m \<ge> 0" by auto
  have "div_ceiling m (abs ?lc) \<ge> 0"
    by (rule order_trans[OF _ div_le_div_ceiling[of m "abs ?lc"]], subst
    pos_imp_zdiv_nonneg_iff, insert p0 m0, auto simp: n_def)
  hence mup: "m_up \<ge> 1" unfolding m_up_def by auto
  have "m_up \<le> 2 ^ (log_ceiling 2 m_up)" using  mup log_ceiling_sound(1) by auto
  hence Cmup: "C \<ge> of_int m_up" unfolding C_def by linarith
  with mup have C: "C \<ge> 1" by auto
  from assms(1)[unfolded root_bound_def Let_def]
  have B: "C = B" unfolding C_def m_up_def n_def m_def by auto
  note dc = div_le_div_ceiling[of m "abs ?lc"]
  with C show "B \<ge> 0" unfolding B by auto
  assume "ipoly p x = 0"
  hence rt: "poly ?p x = 0" by simp
  from root_imp_deg_nonzero[OF _ this] p0 have n0: "n \<noteq> 0" unfolding n_def by auto
  from cauchy_root_bound[OF rt] p0
  have "norm x \<le> 1 + max_list_non_empty ?list' / real_of_int (abs ?lc)"
    by (simp add: n_def)
  also have "?list' = map real_of_int ?list" by simp
  also have "max_list_non_empty \<dots> = real_of_int m" unfolding m_def
    by (rule max_list_non_empty_map, insert mem, auto)
  also have "1 + m / real_of_int (abs ?lc) \<le> real_of_int m_up"
    unfolding m_up_def using div_ceiling[OF alc0, of m] by auto
  also have "\<dots> \<le> real_of_rat C" using Cmup using of_rat_less_eq by force
  finally have "norm x \<le> real_of_rat C" .
  thus "norm x \<le> real_of_rat B" unfolding B by simp
qed

end


(*
    Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
*)
section \<open>More useful lemmas related polynomials\<close>

theory More_Polynomials imports
  Winding_Number_Eval.Missing_Algebraic
  Winding_Number_Eval.Missing_Transcendental
  Sturm_Tarski.PolyMisc
  Budan_Fourier.BF_Misc
begin

subsection \<open>More about @{term order}\<close>

lemma order_normalize[simp]:"order x (normalize p) = order x p"
  by (metis dvd_normalize_iff normalize_eq_0_iff order_1 order_2 order_unique_lemma)

lemma order_gcd:
  assumes "p\<noteq>0" "q\<noteq>0"
  shows "order x (gcd p q) = min (order x p) (order x q)"
proof -
  define xx op oq where "xx=[:- x, 1:]" and "op = order x p" and "oq = order x q"
  obtain pp where pp:"p = xx ^ op * pp" "\<not> xx dvd pp"
    using order_decomp[OF \<open>p\<noteq>0\<close>,of x,folded xx_def op_def] by auto
  obtain qq where qq:"q = xx ^ oq * qq" "\<not> xx dvd qq"
    using order_decomp[OF \<open>q\<noteq>0\<close>,of x,folded xx_def oq_def] by auto
  define pq where "pq = gcd pp qq"

  have p_unfold:"p = (pq * xx ^ (min op oq)) * ((pp div pq) * xx ^ (op - min op oq))"
        and [simp]:"coprime xx (pp div pq)" and "pp\<noteq>0"
  proof -
    have "xx ^ op = xx ^ (min op oq) * xx ^ (op - min op oq)"
      by (simp flip:power_add)
    moreover have "pp = pq * (pp div pq)"
      unfolding pq_def by simp
    ultimately show "p = (pq * xx ^ (min op oq)) * ((pp div pq) * xx ^ (op - min op oq))"
      unfolding pq_def pp by(auto simp:algebra_simps)
    show "coprime xx (pp div pq)"
      apply (rule prime_elem_imp_coprime[OF
                    prime_elem_linear_poly[of 1 "-x",simplified],folded xx_def])
      using \<open>pp = pq * (pp div pq)\<close> pp(2) by auto
  qed (use pp \<open>p\<noteq>0\<close> in auto)
  have q_unfold:"q = (pq * xx ^ (min op oq)) * ((qq div pq) * xx ^ (oq - min op oq))"
         and [simp]:"coprime xx (qq div pq)"
  proof -
    have "xx ^ oq = xx ^ (min op oq) * xx ^ (oq - min op oq)"
      by (simp flip:power_add)
    moreover have "qq = pq * (qq div pq)"
      unfolding pq_def by simp
    ultimately show "q = (pq * xx ^ (min op oq)) * ((qq div pq) * xx ^ (oq - min op oq))"
      unfolding pq_def qq by(auto simp:algebra_simps)
    show "coprime xx (qq div pq)"
      apply (rule prime_elem_imp_coprime[OF
                    prime_elem_linear_poly[of 1 "-x",simplified],folded xx_def])
      using \<open>qq = pq * (qq div pq)\<close> qq(2) by auto
  qed

  have "gcd p q=normalize (pq * xx ^ (min op oq))"
  proof -
    have "coprime (pp div pq * xx ^ (op - min op oq)) (qq div pq * xx ^ (oq - min op oq))"
    proof (cases "op>oq")
      case True
      then have "oq - min op oq = 0" by auto
      moreover have "coprime (xx ^ (op - min op oq)) (qq div pq)" by auto
      moreover have "coprime (pp div pq) (qq div pq)"
        apply (rule div_gcd_coprime[of pp qq,folded pq_def])
        using \<open>pp\<noteq>0\<close> by auto
      ultimately show ?thesis by auto
    next
      case False
      then have "op - min op oq = 0" by auto
      moreover have "coprime (pp div pq) (xx ^ (oq - min op oq))"
        by (auto simp:coprime_commute)
      moreover have "coprime (pp div pq) (qq div pq)"
        apply (rule div_gcd_coprime[of pp qq,folded pq_def])
        using \<open>pp\<noteq>0\<close> by auto
      ultimately show ?thesis by auto
    qed
    then show ?thesis unfolding p_unfold q_unfold
      apply (subst gcd_mult_left)
      by auto
  qed
  then have "order x (gcd p q) = order x pq + order x (xx ^ (min op oq))"
    apply simp
    apply (subst order_mult)
    using assms(1) p_unfold by auto
  also have "... = order x (xx ^ (min op oq))"
    using pp(2) qq(2) unfolding pq_def xx_def
    by (auto simp add: order_0I poly_eq_0_iff_dvd)
  also have "... = min op oq"
    unfolding xx_def by (rule order_power_n_n)
  also have "... = min (order x p) (order x q)" unfolding op_def oq_def by simp
  finally show ?thesis .
qed

lemma pderiv_power: "pderiv (p ^ n) = smult (of_nat n) (p ^ (n-1)) * pderiv p"
  apply (cases n)
  using pderiv_power_Suc by auto

(*TODO: to replace the one (with the same name) in the library, as this version does
  not require 'a to be a field?*)
lemma order_pderiv:
  fixes p::"'a::{idom,semiring_char_0} poly"
  assumes "p\<noteq>0" "poly p x=0"
  shows "order x p = Suc (order x (pderiv p))" using assms
proof -
  define xx op where "xx=[:- x, 1:]" and "op = order x p"
  have "op \<noteq>0" unfolding op_def using assms order_root by blast
  obtain pp where pp:"p = xx ^ op * pp" "\<not> xx dvd pp"
    using order_decomp[OF \<open>p\<noteq>0\<close>,of x,folded xx_def op_def] by auto
  have p_der:"pderiv p = smult (of_nat op) (xx^(op -1)) * pp + xx^op*pderiv pp"
    unfolding pp(1) by (auto simp:pderiv_mult pderiv_power xx_def algebra_simps pderiv_pCons)
  have "xx^(op -1) dvd (pderiv p)"
    unfolding p_der
    by (metis One_nat_def Suc_pred assms(1) assms(2) dvd_add dvd_mult_right dvd_triv_left
        neq0_conv op_def order_root power_Suc smult_dvd_cancel)
  moreover have "\<not> xx^op dvd (pderiv p)"
  proof
    assume "xx ^ op dvd pderiv p"
    then have "xx ^ op dvd smult (of_nat op) (xx^(op -1) * pp)"
      unfolding p_der by (simp add: dvd_add_left_iff)
    then have "xx ^ op dvd (xx^(op -1)) * pp"
      apply (elim dvd_monic[rotated])
      using \<open>op\<noteq>0\<close> by (auto simp:lead_coeff_power xx_def)
    then have "xx ^ (op-1) * xx dvd (xx^(op -1))"
      using \<open>\<not> xx dvd pp\<close> by (simp add: \<open>op \<noteq> 0\<close> mult.commute power_eq_if)
    then have "xx dvd 1"
      using assms(1) pp(1) by auto
    then show False unfolding xx_def by (meson assms(1) dvd_trans one_dvd order_decomp)
  qed
  ultimately have "op - 1 = order x (pderiv p)"
    using order_unique_lemma[of x "op-1" "pderiv p",folded xx_def] \<open>op\<noteq>0\<close>
    by auto
  then show ?thesis using \<open>op\<noteq>0\<close> unfolding op_def by auto
qed

subsection \<open>More about @{term rsquarefree}\<close>

lemma rsquarefree_0[simp]: "\<not> rsquarefree 0"
  unfolding rsquarefree_def by simp

lemma rsquarefree_times:
  assumes "rsquarefree (p*q)"
  shows "rsquarefree q" using assms
proof (induct p rule:poly_root_induct_alt)
  case 0
  then show ?case by simp
next
  case (no_proots p)
  then have [simp]:"p\<noteq>0" "q\<noteq>0" "\<And>a. order a p = 0"
    using order_0I by auto
  have "order a (p * q) = 0 \<longleftrightarrow> order a q = 0"
       "order a (p * q) = 1 \<longleftrightarrow> order a q = 1"
       for a
    subgoal by (subst order_mult) auto
    subgoal by (subst order_mult) auto
    done
  then show ?case using \<open>rsquarefree (p * q)\<close>
    unfolding rsquarefree_def by simp
next
  case (root a p)
  define pq aa where "pq = p * q" and "aa = [:- a, 1:]"
  have [simp]:"pq\<noteq>0" "aa\<noteq>0" "order a aa=1"
    subgoal using pq_def root.prems by auto
    subgoal by (simp add: aa_def)
    subgoal by (metis aa_def order_power_n_n power_one_right)
    done
  have "rsquarefree (aa * pq)"
    unfolding aa_def pq_def using root(2) by (simp add:algebra_simps)
  then have "rsquarefree pq"
    unfolding rsquarefree_def by (auto simp add:order_mult)
  from root(1)[OF this[unfolded pq_def]] show ?case .
qed

lemma rsquarefree_smult_iff:
  assumes "s\<noteq>0"
  shows "rsquarefree (smult s p) \<longleftrightarrow> rsquarefree p"
  unfolding rsquarefree_def using assms by (auto simp add:order_smult)

lemma card_proots_within_rsquarefree:
  assumes "rsquarefree p"
  shows "proots_count p s = card (proots_within p s)" using assms
proof (induct rule:poly_root_induct[of _ "\<lambda>x. x\<in>s"])
  case 0
  then have False by simp
  then show ?case by simp
next
  case (no_roots p)
  then show ?case
    by (metis all_not_in_conv card_empty proots_count_def proots_within_iff sum.empty)
next
  case (root a p)
  have "proots_count ([:a, - 1:] * p) s = 1 + proots_count p s"
    apply (subst proots_count_times)
    subgoal using root.prems rsquarefree_def by blast
    subgoal by (metis (no_types, hide_lams) add.inverse_inverse add.inverse_neutral
                  minus_pCons proots_count_pCons_1_iff proots_count_uminus root.hyps(1))
    done
  also have "... = 1 + card (proots_within p s)"
  proof -
    have "rsquarefree p" using \<open>rsquarefree ([:a, - 1:] * p)\<close>
      by (elim rsquarefree_times)
    from root(2)[OF this] show ?thesis by simp
  qed
  also have "... = card (proots_within ([:a, - 1:] * p) s)" unfolding proots_within_times
  proof (subst card_Un_disjoint)
    have [simp]:"p\<noteq>0" using root.prems by auto
    show "finite (proots_within [:a, - 1:] s)" "finite (proots_within p s)"
      by auto
    show " 1 + card (proots_within p s) = card (proots_within [:a, - 1:] s)
               + card (proots_within p s)"
      using \<open>a \<in> s\<close>
      apply (subst proots_within_pCons_1_iff)
      by simp
    have "poly p a\<noteq>0"
    proof (rule ccontr)
      assume "\<not> poly p a \<noteq> 0"
      then have "order a p >0" by (simp add: order_root)
      moreover have "order a [:a,-1:] = 1"
        by (metis (no_types, hide_lams) add.inverse_inverse add.inverse_neutral minus_pCons
            order_power_n_n order_uminus power_one_right)
      ultimately have "order a  ([:a, - 1:] * p) > 1"
        apply (subst order_mult)
        subgoal using root.prems by auto
        subgoal by auto
        done
      then show False using \<open>rsquarefree ([:a, - 1:] * p)\<close>
        unfolding rsquarefree_def using gr_implies_not0 less_not_refl2 by blast
    qed
    then show " proots_within [:a, - 1:] s \<inter> proots_within p s = {}"
      using proots_within_pCons_1_iff(2) by auto
  qed
  finally show ?case .
qed

lemma rsquarefree_gcd_pderiv:
  fixes p::"'a::{factorial_ring_gcd,semiring_gcd_mult_normalize,semiring_char_0} poly"
  assumes "p\<noteq>0"
  shows "rsquarefree (p div (gcd p (pderiv p)))"
proof (cases "pderiv p = 0")
  case True
  have "poly (unit_factor p) x \<noteq>0" for x
    using unit_factor_is_unit[OF \<open>p\<noteq>0\<close>]
    by (meson assms dvd_trans order_decomp poly_eq_0_iff_dvd unit_factor_dvd)
  then have "order x (unit_factor p) = 0" for x
    using order_0I by blast
  then show ?thesis using True \<open>p\<noteq>0\<close> unfolding rsquarefree_def by simp
next
  case False
  define q where "q = p div (gcd p (pderiv p))"
  have "q\<noteq>0" unfolding q_def by (simp add: assms dvd_div_eq_0_iff)

  have order_pq:"order x p = order x q + min (order x p) (order x (pderiv p))"
    for x
  proof -
    have *:"p = q * gcd p (pderiv p)"
      unfolding q_def by simp
    show ?thesis
      apply (subst *)
      using \<open>q\<noteq>0\<close> \<open>p\<noteq>0\<close> \<open>pderiv p\<noteq>0\<close> by (simp add:order_mult order_gcd)
  qed
  have "order x q = 0 \<or> order x q=1" for x
  proof (cases "poly p x=0")
    case True
    from order_pderiv[OF \<open>p\<noteq>0\<close> this]
    have "order x p = order x (pderiv p) + 1" by simp
    then show ?thesis using order_pq[of x] by auto
  next
    case False
    then have "order x p = 0" by (simp add: order_0I)
    then have "order x q = 0" using order_pq[of x] by simp
    then show ?thesis by simp
  qed
  then show ?thesis using \<open>q\<noteq>0\<close> unfolding rsquarefree_def q_def
    by auto
qed

lemma poly_gcd_pderiv_iff:
  fixes p::"'a::{semiring_char_0,factorial_ring_gcd,semiring_gcd_mult_normalize} poly"
  shows "poly (p div (gcd p (pderiv p))) x =0 \<longleftrightarrow> poly p x=0"
proof (cases "pderiv p=0")
  case True
  then obtain a where "p=[:a:]" using pderiv_iszero by auto
  then show ?thesis by (auto simp add: unit_factor_poly_def)
next
  case False
  then have "p\<noteq>0" using pderiv_0 by blast
  define q where "q = p div (gcd p (pderiv p))"
  have "q\<noteq>0" unfolding q_def by (simp add: \<open>p\<noteq>0\<close> dvd_div_eq_0_iff)

  have order_pq:"order x p = order x q + min (order x p) (order x (pderiv p))" for x
  proof -
    have *:"p = q * gcd p (pderiv p)"
      unfolding q_def by simp
    show ?thesis
      apply (subst *)
      using \<open>q\<noteq>0\<close> \<open>p\<noteq>0\<close> \<open>pderiv p\<noteq>0\<close> by (simp add:order_mult order_gcd)
  qed

  have "order x q =0 \<longleftrightarrow> order x p = 0"
  proof (cases "poly p x=0")
    case True
    from order_pderiv[OF \<open>p\<noteq>0\<close> this]
    have "order x p = order x (pderiv p) + 1" by simp
    then show ?thesis using order_pq[of x] by auto
  next
    case False
    then have "order x p = 0" by (simp add: order_0I)
    then have "order x q = 0" using order_pq[of x] by simp
    then show ?thesis using \<open>order x p = 0\<close> by simp
  qed
  then show ?thesis
    apply (fold q_def)
    unfolding order_root using \<open>p\<noteq>0\<close> \<open>q\<noteq>0\<close> by auto
qed

subsection \<open>Composition of a polynomial and a circular path\<close>

lemma poly_circlepath_tan_eq:
  fixes z0::complex and r::real and p::"complex poly"
  defines "q1\<equiv> fcompose p [:(z0+r)*\<i>,z0-r:] [:\<i>,1:]" and "q2 \<equiv> [:\<i>,1:] ^ degree p"
  assumes "0\<le>t" "t\<le>1" "t\<noteq>1/2"
  shows "poly p (circlepath z0 r t) = poly q1 (tan (pi*t)) / poly q2 (tan (pi*t))"
    (is "?L = ?R")
proof -
  have "?L = poly p (z0+ r*exp (2 * of_real pi * \<i>  * t))"
    unfolding circlepath by simp
  also have "... = ?R"
  proof -
    define f where "f = (poly p \<circ> (\<lambda>x::real. z0 + r * exp (\<i> * x)))"
    have f_eq:"f t = ((\<lambda>x::real. poly q1 x / poly q2 x) o  (\<lambda>x. tan (x/2)) ) t"
      when "cos (t / 2) \<noteq> 0" for t
    proof -
      have "f t = poly p (z0 + r * (cos t + \<i> * sin t)) "
        unfolding f_def exp_Euler  by (auto simp add:cos_of_real sin_of_real)
      also have "... = poly p ((\<lambda>x. ((z0-r)*x+(z0+r)*\<i>) / (\<i>+x)) (tan (t/2)))"
      proof -
        define tt where "tt=complex_of_real (tan (t / 2))"
        define rr where "rr = complex_of_real r"
        have "cos t = (1-tt*tt) / (1 + tt * tt)"
             "sin t = 2*tt  / (1 + tt * tt)"
          unfolding sin_tan_half[of "t/2",simplified] cos_tan_half[of "t/2",OF that, simplified] tt_def
          by (auto simp add:power2_eq_square)
        moreover have "1 + tt * tt \<noteq> 0" unfolding tt_def
          apply (fold of_real_mult)
          by (metis (no_types, hide_lams) mult_numeral_1 numeral_One of_real_add of_real_eq_0_iff
              of_real_numeral sum_squares_eq_zero_iff zero_neq_one)
        ultimately have "z0 +  r * ( (cos t) + \<i> * (sin t))
            =(z0*(1+tt*tt)+rr*(1-tt*tt)+\<i>*rr*2*tt ) / (1 + tt * tt) "
          apply (fold rr_def,simp add:add_divide_distrib)
          by (simp add:algebra_simps)
        also have "... = ((z0-rr)*tt+z0*\<i>+rr*\<i>) / (tt + \<i>)"
        proof -
          have "tt + \<i> \<noteq> 0"
            using \<open>1 + tt * tt \<noteq> 0\<close>
            by (metis i_squared neg_eq_iff_add_eq_0 square_eq_iff)
          then show ?thesis
            using \<open>1 + tt * tt \<noteq> 0\<close> by (auto simp add:divide_simps algebra_simps)
        qed
        finally have "z0 +  r * ( (cos t) + \<i> * (sin t)) = ((z0-rr)*tt+z0*\<i>+rr*\<i>) / (tt + \<i>)" .
        then show ?thesis unfolding tt_def rr_def
          by (auto simp add:algebra_simps power2_eq_square)
      qed
      also have "... = (poly p o ((\<lambda>x. ((z0-r)*x+(z0+r)*\<i>) / (\<i>+x)) o (\<lambda>x. tan (x/2)) )) t"
        unfolding comp_def by (auto simp:tan_of_real)
      also have "... = ((\<lambda>x::real. poly q1 x / poly q2 x) o  (\<lambda>x. tan (x/2)) ) t"
        unfolding q2_def q1_def
        apply (subst fcompose_poly[symmetric])
        subgoal for x
          apply simp
          by (metis Re_complex_of_real add_cancel_right_left complex_i_not_zero imaginary_unit.sel(1) plus_complex.sel(1) rcis_zero_arg rcis_zero_mod)
        subgoal by (auto simp:tan_of_real algebra_simps)
        done
      finally show ?thesis .
    qed

    have "cos (pi * t) \<noteq>0" unfolding cos_zero_iff_int2
    proof
      assume "\<exists>i. pi * t = real_of_int i * pi + pi / 2"
      then obtain i where "pi * t = real_of_int i * pi + pi / 2" by auto
      then have "pi * t=pi * (real_of_int i + 1 / 2)" by (simp add:algebra_simps)
      then have "t=real_of_int i + 1 / 2" by auto
      then show False using \<open>0\<le>t\<close> \<open>t\<le>1\<close> \<open>t\<noteq>1/2\<close> by auto
    qed
    from f_eq[of "2*pi*t",simplified,OF this]
    show "?thesis"
      unfolding f_def comp_def by (auto simp add:algebra_simps)
  qed
  finally show ?thesis .
qed

end