theory T50
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z)))
"
nitpick[card nat=8,timeout=86400]
oops
end


(*  Title:       IsomorphismClass
    Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
    Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
*)

section "Isomorphism Classes"

text \<open>
  The following is a small theory that facilitates working with isomorphism classes of objects
  in a category.
\<close>

theory IsomorphismClass
imports Category3.EpiMonoIso Category3.NaturalTransformation
begin

  context category
  begin

    notation isomorphic (infix "\<cong>" 50)

    definition iso_class ("\<lbrakk>_\<rbrakk>")
    where "iso_class f \<equiv> {f'. f \<cong> f'}"

    definition is_iso_class
    where "is_iso_class F \<equiv> \<exists>f. f \<in> F \<and> F = iso_class f"

    definition iso_class_rep
    where "iso_class_rep F \<equiv> SOME f. f \<in> F"

    lemmas isomorphic_transitive [trans]
    lemmas naturally_isomorphic_transitive [trans]

    lemma inv_in_homI [intro]:
    assumes "iso f" and "\<guillemotleft>f : a \<rightarrow> b\<guillemotright>"
    shows "\<guillemotleft>inv f : b \<rightarrow> a\<guillemotright>"
      using assms inv_is_inverse seqE inverse_arrowsE
      by (metis ide_compE in_homE in_homI)

    lemma iso_class_is_nonempty:
    assumes "is_iso_class F"
    shows "F \<noteq> {}"
      using assms is_iso_class_def iso_class_def by auto

    lemma iso_class_memb_is_ide:
    assumes "is_iso_class F" and "f \<in> F"
    shows "ide f"
      using assms is_iso_class_def iso_class_def isomorphic_def by auto

    lemma ide_in_iso_class:
    assumes "ide f"
    shows "f \<in> \<lbrakk>f\<rbrakk>"
      using assms iso_class_def is_iso_class_def isomorphic_reflexive by simp

    lemma rep_in_iso_class:
    assumes "is_iso_class F"
    shows "iso_class_rep F \<in> F"
      using assms is_iso_class_def iso_class_rep_def someI_ex [of "\<lambda>f. f \<in> F"]
            ide_in_iso_class
      by metis

    lemma is_iso_classI:
    assumes "ide f"
    shows "is_iso_class \<lbrakk>f\<rbrakk>"
      using assms iso_class_def is_iso_class_def isomorphic_reflexive by blast

    lemma rep_iso_class:
    assumes "ide f"
    shows "iso_class_rep \<lbrakk>f\<rbrakk> \<cong> f"
      using assms is_iso_classI rep_in_iso_class iso_class_def isomorphic_symmetric
      by blast

    lemma iso_class_eqI [intro]:
    assumes "f \<cong> g"
    shows "\<lbrakk>f\<rbrakk> = \<lbrakk>g\<rbrakk>"
    proof -
      have f: "ide f"
        using assms isomorphic_def by auto
      have g: "ide g"
        using assms isomorphic_def by auto
      have "f \<in> \<lbrakk>g\<rbrakk>"
        using assms iso_class_def isomorphic_symmetric by simp
      moreover have "g \<in> \<lbrakk>g\<rbrakk>"
        using assms g iso_class_def isomorphic_reflexive isomorphic_def by simp
      ultimately have "\<And>h. (h \<in> \<lbrakk>f\<rbrakk>) = (h \<in> \<lbrakk>g\<rbrakk>)"
        using assms g iso_class_def [of f] iso_class_def [of g]
              isomorphic_reflexive isomorphic_symmetric isomorphic_transitive
        by blast
      thus ?thesis by auto
    qed

    lemma iso_class_eq:
    assumes "is_iso_class F" and "is_iso_class G" and "F \<inter> G \<noteq> {}"
    shows "F = G"
    proof -
      obtain h where h: "h \<in> F \<and> h \<in> G"
        using assms by auto
      show ?thesis
        using assms h
        by (metis is_iso_class_def iso_class_elems_isomorphic iso_class_eqI)
    qed

    lemma iso_class_rep [simp]:
    assumes "is_iso_class F"
    shows "\<lbrakk>iso_class_rep F\<rbrakk> = F"
    proof (intro iso_class_eq)
      show "is_iso_class \<lbrakk>iso_class_rep F\<rbrakk>"
        using assms is_iso_classI iso_class_memb_is_ide rep_in_iso_class by blast
      show "is_iso_class F"
        using assms by simp
      show "\<lbrakk>iso_class_rep F\<rbrakk> \<inter> F \<noteq> {}"
        using assms rep_in_iso_class
        by (meson disjoint_iff_not_equal ide_in_iso_class iso_class_memb_is_ide)
    qed

  end

end


(*  Title:     HOL/Probability/Helly_Selection.thy
    Authors:   Jeremy Avigad (CMU), Luke Serafin (CMU)
    Authors:   Johannes Hölzl, TU München
*)

section \<open>Helly's selection theorem\<close>

text \<open>The set of bounded, monotone, right continuous functions is sequentially compact\<close>

theory Helly_Selection
  imports "~~/src/HOL/Library/Diagonal_Subsequence" Weak_Convergence
begin

lemma minus_one_less: "x - 1 < (x::real)"
  by simp

theorem Helly_selection:
  fixes f :: "nat \<Rightarrow> real \<Rightarrow> real"
  assumes rcont: "\<And>n x. continuous (at_right x) (f n)"
  assumes mono: "\<And>n. mono (f n)"
  assumes bdd: "\<And>n x. \<bar>f n x\<bar> \<le> M"
  shows "\<exists>s. subseq s \<and> (\<exists>F. (\<forall>x. continuous (at_right x) F) \<and> mono F \<and> (\<forall>x. \<bar>F x\<bar> \<le> M) \<and>
    (\<forall>x. continuous (at x) F \<longrightarrow> (\<lambda>n. f (s n) x) \<longlonglongrightarrow> F x))"
proof -
  obtain m :: "real \<Rightarrow> nat" where "bij_betw m \<rat> UNIV"
    using countable_rat Rats_infinite by (erule countableE_infinite)
  then obtain r :: "nat \<Rightarrow> real" where bij: "bij_betw r UNIV \<rat>"
    using bij_betw_inv by blast

  have dense_r: "\<And>x y. x < y \<Longrightarrow> \<exists>n. x < r n \<and> r n < y"
    by (metis Rats_dense_in_real bij f_the_inv_into_f bij_betw_def)

  let ?P = "\<lambda>n. \<lambda>s. convergent (\<lambda>k. f (s k) (r n))"
  interpret nat: subseqs ?P
  proof (unfold convergent_def, unfold subseqs_def, auto)
    fix n :: nat and s :: "nat \<Rightarrow> nat" assume s: "subseq s"
    have "bounded {-M..M}"
      using bounded_closed_interval by auto
    moreover have "\<And>k. f (s k) (r n) \<in> {-M..M}"
      using bdd by (simp add: abs_le_iff minus_le_iff)
    ultimately have "\<exists>l s'. subseq s' \<and> ((\<lambda>k. f (s k) (r n)) \<circ> s') \<longlonglongrightarrow> l"
      using compact_Icc compact_imp_seq_compact seq_compactE by metis
    thus "\<exists>s'. subseq s' \<and> (\<exists>l. (\<lambda>k. f (s (s' k)) (r n)) \<longlonglongrightarrow> l)"
      by (auto simp: comp_def)
  qed
  define d where "d = nat.diagseq"
  have subseq: "subseq d"
    unfolding d_def using nat.subseq_diagseq by auto
  have rat_cnv: "?P n d" for n
  proof -
    have Pn_seqseq: "?P n (nat.seqseq (Suc n))"
      by (rule nat.seqseq_holds)
    have 1: "(\<lambda>k. f ((nat.seqseq (Suc n) \<circ> (\<lambda>k. nat.fold_reduce (Suc n) k
      (Suc n + k))) k) (r n)) = (\<lambda>k. f (nat.seqseq (Suc n) k) (r n)) \<circ>
      (\<lambda>k. nat.fold_reduce (Suc n) k (Suc n + k))"
      by auto
    have 2: "?P n (d \<circ> (op + (Suc n)))"
      unfolding d_def nat.diagseq_seqseq 1
      by (intro convergent_subseq_convergent Pn_seqseq nat.subseq_diagonal_rest)
    then obtain L where 3: "(\<lambda>na. f (d (na + Suc n)) (r n)) \<longlonglongrightarrow> L"
      by (auto simp: add.commute dest: convergentD)
    then have "(\<lambda>k. f (d k) (r n)) \<longlonglongrightarrow> L"
      by (rule LIMSEQ_offset)
    then show ?thesis
      by (auto simp: convergent_def)
  qed
  let ?f = "\<lambda>n. \<lambda>k. f (d k) (r n)"
  have lim_f: "?f n \<longlonglongrightarrow> lim (?f n)" for n
    using rat_cnv convergent_LIMSEQ_iff by auto
  have lim_bdd: "lim (?f n) \<in> {-M..M}" for n
  proof -
    have "closed {-M..M}" using closed_real_atLeastAtMost by auto
    hence "(\<forall>i. ?f n i \<in> {-M..M}) \<and> ?f n \<longlonglongrightarrow> lim (?f n) \<longrightarrow> lim (?f n) \<in> {-M..M}"
      unfolding closed_sequential_limits by (drule_tac x = "\<lambda>k. f (d k) (r n)" in spec) blast
    moreover have "\<forall>i. ?f n i \<in> {-M..M}"
      using bdd by (simp add: abs_le_iff minus_le_iff)
    ultimately show "lim (?f n) \<in> {-M..M}"
      using lim_f by auto
  qed
  then have limset_bdd: "\<And>x. {lim (?f n) |n. x < r n} \<subseteq> {-M..M}"
    by auto
  then have bdd_below: "bdd_below {lim (?f n) |n. x < r n}" for x
    by (metis (mono_tags) bdd_below_Icc bdd_below_mono)
  have r_unbdd: "\<exists>n. x < r n" for x
    using dense_r[OF less_add_one, of x] by auto
  then have nonempty: "{lim (?f n) |n. x < r n} \<noteq> {}" for x
    by auto

  define F where "F x = Inf {lim (?f n) |n. x < r n}" for x
  have F_eq: "ereal (F x) = (INF n:{n. x < r n}. ereal (lim (?f n)))" for x
    unfolding F_def by (subst ereal_Inf'[OF bdd_below nonempty]) (simp add: setcompr_eq_image)
  have mono_F: "mono F"
    using nonempty by (auto intro!: cInf_superset_mono simp: F_def bdd_below mono_def)
  moreover have "\<And>x. continuous (at_right x) F"
    unfolding continuous_within order_tendsto_iff eventually_at_right[OF less_add_one]
  proof safe
    show "F x < u \<Longrightarrow> \<exists>b>x. \<forall>y>x. y < b \<longrightarrow> F y < u" for x u
      unfolding F_def cInf_less_iff[OF nonempty bdd_below] by auto
  next
    show "\<exists>b>x. \<forall>y>x. y < b \<longrightarrow> l < F y" if l: "l < F x" for x l
      using less_le_trans[OF l mono_F[THEN monoD, of x]] by (auto intro: less_add_one)
  qed
  moreover
  { fix x
    have "F x \<in> {-M..M}"
      unfolding F_def using limset_bdd bdd_below r_unbdd by (intro closed_subset_contains_Inf) auto
    then have "\<bar>F x\<bar> \<le> M" by auto }
  moreover have "(\<lambda>n. f (d n) x) \<longlonglongrightarrow> F x" if cts: "continuous (at x) F" for x
  proof (rule limsup_le_liminf_real)
    show "limsup (\<lambda>n. f (d n) x) \<le> F x"
    proof (rule tendsto_lowerbound)
      show "(F \<longlongrightarrow> ereal (F x)) (at_right x)"
        using cts unfolding continuous_at_split by (auto simp: continuous_within)
      show "\<forall>\<^sub>F i in at_right x. limsup (\<lambda>n. f (d n) x) \<le> F i"
        unfolding eventually_at_right[OF less_add_one]
      proof (rule, rule, rule less_add_one, safe)
        fix y assume y: "x < y"
        with dense_r obtain N where "x < r N" "r N < y" by auto
        have *: "y < r n' \<Longrightarrow> lim (?f N) \<le> lim (?f n')" for n'
          using \<open>r N < y\<close> by (intro LIMSEQ_le[OF lim_f lim_f]) (auto intro!: mono[THEN monoD])
        have "limsup (\<lambda>n. f (d n) x) \<le> limsup (?f N)"
          using \<open>x < r N\<close> by (auto intro!: Limsup_mono always_eventually mono[THEN monoD])
        also have "\<dots> = lim (\<lambda>n. ereal (?f N n))"
          using rat_cnv[of N] by (force intro!: convergent_limsup_cl simp: convergent_def)
        also have "\<dots> \<le> F y"
          by (auto intro!: INF_greatest * simp: convergent_real_imp_convergent_ereal rat_cnv F_eq)
        finally show "limsup (\<lambda>n. f (d n) x) \<le> F y" .
      qed
    qed simp
    show "F x \<le> liminf (\<lambda>n. f (d n) x)"
    proof (rule tendsto_upperbound)
      show "(F \<longlongrightarrow> ereal (F x)) (at_left x)"
        using cts unfolding continuous_at_split by (auto simp: continuous_within)
      show "\<forall>\<^sub>F i in at_left x. F i \<le> liminf (\<lambda>n. f (d n) x)"
        unfolding eventually_at_left[OF minus_one_less]
      proof (rule, rule, rule minus_one_less, safe)
        fix y assume y: "y < x"
        with dense_r obtain N where "y < r N" "r N < x" by auto
        have "F y \<le> liminf (?f N)"
          using \<open>y < r N\<close> by (auto simp: F_eq convergent_real_imp_convergent_ereal
            rat_cnv convergent_liminf_cl intro!: INF_lower2)
        also have "\<dots> \<le> liminf (\<lambda>n. f (d n) x)"
          using \<open>r N < x\<close> by (auto intro!: Liminf_mono monoD[OF mono] always_eventually)
        finally show "F y \<le> liminf (\<lambda>n. f (d n) x)" .
      qed
    qed simp
  qed
  ultimately show ?thesis using subseq by auto
qed

(** Weak convergence corollaries to Helly's theorem. **)

definition
  tight :: "(nat \<Rightarrow> real measure) \<Rightarrow> bool"
where
  "tight \<mu> \<equiv> (\<forall>n. real_distribution (\<mu> n)) \<and> (\<forall>(\<epsilon>::real)>0. \<exists>a b::real. a < b \<and> (\<forall>n. measure (\<mu> n) {a<..b} > 1 - \<epsilon>))"

(* Can strengthen to equivalence. *)
theorem tight_imp_convergent_subsubsequence:
  assumes \<mu>: "tight \<mu>" "subseq s"
  shows "\<exists>r M. subseq r \<and> real_distribution M \<and> weak_conv_m (\<mu> \<circ> s \<circ> r) M"
proof -
  define f where "f k = cdf (\<mu> (s k))" for k
  interpret \<mu>: real_distribution "\<mu> k" for k
    using \<mu> unfolding tight_def by auto

  have rcont: "\<And>x. continuous (at_right x) (f k)"
    and mono: "mono (f k)"
    and top: "(f k \<longlongrightarrow> 1) at_top"
    and bot: "(f k \<longlongrightarrow> 0) at_bot" for k
    unfolding f_def mono_def
    using \<mu>.cdf_nondecreasing \<mu>.cdf_is_right_cont \<mu>.cdf_lim_at_top_prob \<mu>.cdf_lim_at_bot by auto
  have bdd: "\<bar>f k x\<bar> \<le> 1" for k x
    by (auto simp add: abs_le_iff minus_le_iff f_def \<mu>.cdf_nonneg \<mu>.cdf_bounded_prob)

  from Helly_selection[OF rcont mono bdd, of "\<lambda>x. x"] obtain r F
    where F: "subseq r" "\<And>x. continuous (at_right x) F" "mono F" "\<And>x. \<bar>F x\<bar> \<le> 1"
    and lim_F: "\<And>x. continuous (at x) F \<Longrightarrow> (\<lambda>n. f (r n) x) \<longlonglongrightarrow> F x"
    by blast

  have "0 \<le> f n x" for n x
    unfolding f_def by (rule \<mu>.cdf_nonneg)
  have F_nonneg: "0 \<le> F x" for x
  proof -
    obtain y where "y < x" "isCont F y"
      using open_minus_countable[OF mono_ctble_discont[OF \<open>mono F\<close>], of "{..< x}"] by auto
    then have "0 \<le> F y"
      by (intro LIMSEQ_le_const[OF lim_F]) (auto simp: f_def \<mu>.cdf_nonneg)
    also have "\<dots> \<le> F x"
      using \<open>y < x\<close> by (auto intro!: monoD[OF \<open>mono F\<close>])
    finally show "0 \<le> F x" .
  qed

  have Fab: "\<exists>a b. (\<forall>x\<ge>b. F x \<ge> 1 - \<epsilon>) \<and> (\<forall>x\<le>a. F x \<le> \<epsilon>)" if \<epsilon>: "0 < \<epsilon>" for \<epsilon>
  proof auto
    obtain a' b' where a'b': "a' < b'" "\<And>k. measure (\<mu> k) {a'<..b'} > 1 - \<epsilon>"
      using \<epsilon> \<mu> by (auto simp: tight_def)
    obtain a where a: "a < a'" "isCont F a"
      using open_minus_countable[OF mono_ctble_discont[OF \<open>mono F\<close>], of "{..< a'}"] by auto
    obtain b where b: "b' < b" "isCont F b"
      using open_minus_countable[OF mono_ctble_discont[OF \<open>mono F\<close>], of "{b' <..}"] by auto
    have "a < b"
      using a b a'b' by simp

    let ?\<mu> = "\<lambda>k. measure (\<mu> (s (r k)))"
    have ab: "?\<mu> k {a<..b} > 1 - \<epsilon>" for k
    proof -
      have "?\<mu> k {a'<..b'} \<le> ?\<mu> k {a<..b}"
        using a b by (intro \<mu>.finite_measure_mono) auto
      then show ?thesis
        using a'b'(2) by (metis less_eq_real_def less_trans)
    qed

    have "(\<lambda>k. ?\<mu> k {..b}) \<longlonglongrightarrow> F b"
      using b(2) lim_F unfolding f_def cdf_def o_def by auto
    then have "1 - \<epsilon> \<le> F b"
    proof (rule tendsto_lowerbound, intro always_eventually allI)
      fix k
      have "1 - \<epsilon> < ?\<mu> k {a<..b}"
        using ab by auto
      also have "\<dots> \<le> ?\<mu> k {..b}"
        by (auto intro!: \<mu>.finite_measure_mono)
      finally show "1 - \<epsilon> \<le> ?\<mu> k {..b}"
        by (rule less_imp_le)
    qed (rule sequentially_bot)
    then show "\<exists>b. \<forall>x\<ge>b. 1 - \<epsilon> \<le> F x"
      using F unfolding mono_def by (metis order.trans)

    have "(\<lambda>k. ?\<mu> k {..a}) \<longlonglongrightarrow> F a"
      using a(2) lim_F unfolding f_def cdf_def o_def by auto
    then have Fa: "F a \<le> \<epsilon>"
    proof (rule tendsto_upperbound, intro always_eventually allI)
      fix k
      have "?\<mu> k {..a} + ?\<mu> k {a<..b} \<le> 1"
        by (subst \<mu>.finite_measure_Union[symmetric]) auto
      then show "?\<mu> k {..a} \<le> \<epsilon>"
        using ab[of k] by simp
    qed (rule sequentially_bot)
    then show "\<exists>a. \<forall>x\<le>a. F x \<le> \<epsilon>"
      using F unfolding mono_def by (metis order.trans)
  qed

  have "(F \<longlongrightarrow> 1) at_top"
  proof (rule order_tendstoI)
    show "1 < y \<Longrightarrow> \<forall>\<^sub>F x in at_top. F x < y" for y
      using \<open>\<And>x. \<bar>F x\<bar> \<le> 1\<close> \<open>\<And>x. 0 \<le> F x\<close> by (auto intro: le_less_trans always_eventually)
    fix y :: real assume "y < 1"
    then obtain z where "y < z" "z < 1"
      using dense[of y 1] by auto
    with Fab[of "1 - z"] show "\<forall>\<^sub>F x in at_top. y < F x"
      by (auto simp: eventually_at_top_linorder intro: less_le_trans)
  qed
  moreover
  have "(F \<longlongrightarrow> 0) at_bot"
  proof (rule order_tendstoI)
    show "y < 0 \<Longrightarrow> \<forall>\<^sub>F x in at_bot. y < F x" for y
      using \<open>\<And>x. 0 \<le> F x\<close> by (auto intro: less_le_trans always_eventually)
    fix y :: real assume "0 < y"
    then obtain z where "0 < z" "z < y"
      using dense[of 0 y] by auto
    with Fab[of z] show "\<forall>\<^sub>F x in at_bot. F x < y"
      by (auto simp: eventually_at_bot_linorder intro: le_less_trans)
  qed
  ultimately have M: "real_distribution (interval_measure F)" "cdf (interval_measure F) = F"
    using F by (auto intro!: real_distribution_interval_measure cdf_interval_measure simp: mono_def)
  with lim_F LIMSEQ_subseq_LIMSEQ M have "weak_conv_m (\<mu> \<circ> s \<circ> r) (interval_measure F)"
    by (auto simp: weak_conv_def weak_conv_m_def f_def comp_def)
  then show "\<exists>r M. subseq r \<and> (real_distribution M \<and> weak_conv_m (\<mu> \<circ> s \<circ> r) M)"
    using F M by auto
qed

corollary tight_subseq_weak_converge:
  fixes \<mu> :: "nat \<Rightarrow> real measure" and M :: "real measure"
  assumes "\<And>n. real_distribution (\<mu> n)" "real_distribution M" and tight: "tight \<mu>" and
    subseq: "\<And>s \<nu>. subseq s \<Longrightarrow> real_distribution \<nu> \<Longrightarrow> weak_conv_m (\<mu> \<circ> s) \<nu> \<Longrightarrow> weak_conv_m (\<mu> \<circ> s) M"
  shows "weak_conv_m \<mu> M"
proof (rule ccontr)
  define f where "f n = cdf (\<mu> n)" for n
  define F where "F = cdf M"

  assume "\<not> weak_conv_m \<mu> M"
  then obtain x where x: "isCont F x" "\<not> (\<lambda>n. f n x) \<longlonglongrightarrow> F x"
    by (auto simp: weak_conv_m_def weak_conv_def f_def F_def)
  then obtain \<epsilon> where "\<epsilon> > 0" and "infinite {n. \<not> dist (f n x) (F x) < \<epsilon>}"
    by (auto simp: tendsto_iff not_eventually INFM_iff_infinite cofinite_eq_sequentially[symmetric])
  then obtain s where s: "\<And>n. \<not> dist (f (s n) x) (F x) < \<epsilon>" and "subseq s"
    using enumerate_in_set enumerate_mono by (fastforce simp: subseq_def)
  then obtain r \<nu> where r: "subseq r" "real_distribution \<nu>" "weak_conv_m (\<mu> \<circ> s \<circ> r) \<nu>"
    using tight_imp_convergent_subsubsequence[OF tight] by blast
  then have "weak_conv_m (\<mu> \<circ> (s \<circ> r)) M"
    using \<open>subseq s\<close> r by (intro subseq subseq_o) (auto simp: comp_assoc)
  then have "(\<lambda>n. f (s (r n)) x) \<longlonglongrightarrow> F x"
    using x by (auto simp: weak_conv_m_def weak_conv_def F_def f_def)
  then show False
    using s \<open>\<epsilon> > 0\<close> by (auto dest: tendstoD)
qed

end


(* Author: Manuel Eberl <eberlm@in.tum.de> *)
theory Misc_Polynomial
imports "~~/src/HOL/Library/Poly_Deriv"
begin

subsection {* Analysis *}

lemma fun_eq_in_ivl:
  assumes "a \<le> b" "\<forall>x::real. a \<le> x \<and> x \<le> b \<longrightarrow> eventually (\<lambda>\<xi>. f \<xi> = f x) (at x)"
  shows "f a = f b"
proof (rule connected_local_const)
  show "connected {a..b}" "a \<in> {a..b}" "b \<in> {a..b}" using `a \<le> b` by (auto intro: connected_Icc)
  show "\<forall>aa\<in>{a..b}. eventually (\<lambda>b. f aa = f b) (at aa within {a..b})"
  proof
    fix x assume "x \<in> {a..b}"
    with assms(2)[rule_format, of x]
    show "eventually (\<lambda>b. f x = f b) (at x within {a..b})"
      by (auto simp: eventually_at_filter elim: eventually_elim1)
  qed
qed

subsection {* Polynomials *}
subsubsection {* General simplification lemmas *}

lemma div_diff:
  fixes a :: "'a::ring_div"
  assumes "q dvd a" "q dvd b"
  shows "a div q - b div q = (a - b) div q"
proof-
  from assms have "a div q + (-b div q) = (a + (-b)) div q"
      by (subst div_add, simp_all)
  thus ?thesis by (simp add: assms dvd_neg_div algebra_simps)
qed

lemma poly_gcd_right_idem: "gcd (gcd (p :: _ poly) q) q = gcd p q"
    by (rule poly_gcd_unique, simp_all add: poly_gcd_monic)
lemma poly_gcd_left_idem: "gcd p (gcd (p :: _ poly) q) = gcd p q"
    by (rule poly_gcd_unique, simp_all add: poly_gcd_monic)

lemma degree_power_eq:
  "(p::('a::idom) poly) \<noteq> 0 \<Longrightarrow> degree (p^n) = n * degree p"
  by (induction n, simp_all add: degree_mult_eq)

lemma poly_altdef: "poly p (x::real) = (\<Sum>i\<le>degree p. coeff p i * x ^ i)"
proof (induction p rule: pCons_induct)
  case (pCons a p)
    show ?case
    proof (cases "p = 0")
      case False
      let ?p' = "pCons a p"
      note poly_pCons[of a p x]
      also note pCons.IH
      also have "a + x * (\<Sum>i\<le>degree p. coeff p i * x ^ i) =
                 coeff ?p' 0 * x^0 + (\<Sum>i\<le>degree p. coeff ?p' (Suc i) * x^Suc i)"
          by (simp add: field_simps setsum_right_distrib coeff_pCons)
      also note setsum_atMost_Suc_shift[symmetric]
      also note degree_pCons_eq[OF `p \<noteq> 0`, of a, symmetric]
      finally show ?thesis .
   qed simp
qed simp

lemma pderiv_div:
  assumes [simp]: "q dvd p" "q \<noteq> 0"
  shows "pderiv (p div q) = (q * pderiv p - p * pderiv q) div (q * q)"
        "q*q dvd (q * pderiv p - p * pderiv q)"
proof-
  note pderiv_mult[of q "p div q"]
  also have "q * (p div q) = p" by (simp add: dvd_mult_div_cancel)
  finally have "q * pderiv (p div q) = q * pderiv p div q - p * pderiv q div q"
      by (simp add: algebra_simps dvd_div_mult[symmetric])
  also have "... = (q * pderiv p - p * pderiv q) div q"
      by (rule div_diff, simp_all)
  finally have A: "pderiv (p div q) * q div q =
                   (q * pderiv p - p * pderiv q) div q div q"
      by (simp add: algebra_simps)
  thus "pderiv (p div q) = (q * pderiv p - p * pderiv q) div (q * q)"
        by (simp add: algebra_simps poly_div_mult_right)
  from assms obtain r where "p = q * r" unfolding dvd_def by blast
  hence "q * pderiv p - p * pderiv q = (q * q) * pderiv r"
      by (simp add: algebra_simps pderiv_mult)
  thus "q*q dvd (q * pderiv p - p * pderiv q)" by simp
qed

subsubsection {* Divisibility of polynomials *}

text {*
  Two polynomials that are coprime have no common roots.
*}
lemma coprime_imp_no_common_roots:
  assumes "coprime p q"
  shows "\<And>x. \<not>(poly p x = 0 \<and> poly q x = 0)"
proof(clarify)
  fix x assume "poly p x = 0" "poly q x = 0"
  hence "[:-x,1:] dvd p" "[:-x,1:] dvd q"
      by (simp_all add: poly_eq_0_iff_dvd)
  hence "[:-x,1:] dvd gcd p q" by simp
  hence "poly (gcd p q) x = 0" by (simp add: poly_eq_0_iff_dvd)
  moreover from assms have "poly (gcd p q) x = 1" by simp
  ultimately show False by simp
qed

text {*
  Dividing two polynomials by their gcd makes them coprime.
*}
lemma div_gcd_coprime_poly:
  assumes "(p :: ('a::field) poly) \<noteq> 0 \<or> q \<noteq> 0"
  defines [simp]: "d \<equiv> gcd p q"
  shows "coprime (p div d) (q div d)"
proof-
  let ?d' = "gcd (p div d) (q div d)"
  from assms have [simp]: "d \<noteq> 0" by simp
  {
    fix r assume "r dvd (p div d)" "r dvd (q div d)"
    then obtain s t where "p div d = r * s" "q div d = r * t"
        unfolding dvd_def by auto
    hence "d * (p div d) = d * (r * s)" "d * (q div d) = d * (r * t)" by simp_all
    hence A: "p = s * (r * d)" "q = t * (r * d)"
        by (auto simp add: algebra_simps dvd_mult_div_cancel)
    have "r * d dvd p" "r * d dvd q" by (subst A, rule dvd_triv_right)+
    hence "d * r dvd d * 1" by (simp add: algebra_simps)
    hence "r dvd 1" using `d \<noteq> 0` by (subst (asm) dvd_mult_cancel_left, auto)
  }
  hence A: "?d' dvd 1" by simp
  from assms(1) have "p div d \<noteq> 0 \<or> q div d \<noteq> 0" by (auto simp: dvd_div_eq_mult)
  hence B: "coeff ?d' (degree ?d') = coeff 1 (degree 1)"
      using poly_gcd_monic[of "p div d" "q div d"] by simp
  from poly_dvd_antisym[OF B A one_dvd] show ?thesis .
qed

lemma poly_div:
  assumes "poly q x \<noteq> 0" and "q dvd p"
  shows "poly (p div q) x = poly p x / poly q x"
proof-
  from assms have [simp]: "q \<noteq> 0" by force
  have "poly q x * poly (p div q) x = poly (q * (p div q)) x" by simp
  also have "q * (p div q) = p"
      using assms by (simp add: div_mult_swap)
  finally show "poly (p div q) x = poly p x / poly q x"
      using assms by (simp add: field_simps)
qed

text {*
  A function that gives witnesses for Bezout's lemma for polynomials.
*}
function bezw_poly where
  "bezw_poly (p::('a::field) poly) q =
      (if q = 0 then ([:inverse (coeff p (degree p)):], 0)
                else (case bezw_poly q (p mod q) of
                        (r,s) \<Rightarrow> (s, r - s * (p div q))))"
by (pat_completeness, simp_all)
termination by (relation "measure (\<lambda>(x, y). if y = 0 then 0 else Suc (degree y))")
               (auto dest: degree_mod_less)
declare bezw_poly.simps[simp del]

text {*
  Bezout's lemma for polynomials.
*}
lemma bezout_poly:
  "gcd p q = fst (bezw_poly p q) * p + snd (bezw_poly p q) * q"
proof (induction p q rule: gcd_poly.induct)
  case (goal1 p)
    show ?case by (subst bezw_poly.simps, simp add: gcd_poly.simps(1))
next
  case (goal2 q p)
    let ?b = "bezw_poly q (p mod q)"
    let ?b' = "bezw_poly p q"

    from goal2 have b'_b: "fst ?b' = snd ?b"
                          "snd ?b' = fst ?b - snd ?b * (p div q)"
        by (subst bezw_poly.simps, simp split: prod.split)+
    hence "fst ?b' * p + snd ?b' * q =
                snd ?b * p + (fst ?b - snd ?b * (p div q)) * q" by simp
    also have "... = fst ?b * q + snd ?b * (p - p div q * q)"
        by (simp add: algebra_simps)
    also have "p - p div q * q = p mod q"
        using mod_div_equality[of p q] by (simp add: algebra_simps)
    also have "fst ?b * q + snd ?b * (p mod q) = gcd q (p mod q)"
        using goal2 by simp
    also have "... = gcd p q"
        using goal2 by (subst gcd_poly.simps(2)[of q p], simp_all)
    finally show ?case ..
qed

lemma bezout_poly': "\<exists>r s. gcd (p::('a::field) poly) q = r*p+s*q"
    using bezout_poly by blast

(* TODO: make this less ugly *)
lemma poly_div_gcd_squarefree_aux:
  assumes "pderiv (p::('a::real_normed_field) poly) \<noteq> 0"
  defines "d \<equiv> gcd p (pderiv p)"
  shows "coprime (p div d) (pderiv (p div d))" and
        "\<And>x. poly (p div d) x = 0 \<longleftrightarrow> poly p x = 0"
proof-
  from bezout_poly' obtain r s where rs: "d = r * p + s * pderiv p"
      unfolding d_def by blast
  def t \<equiv> "p div d"
  def [simp]: p' \<equiv> "pderiv p"
  def [simp]: d' \<equiv> "pderiv d"
  def u \<equiv> "p' div d"
  have A: "p = t * d" and B: "p' = u * d"
      by (simp_all add: t_def u_def dvd_mult_div_cancel d_def algebra_simps)
  from poly_squarefree_decomp[OF assms(1) A B[unfolded p'_def] rs]
      show "\<And>x. poly (p div d) x = 0 \<longleftrightarrow> poly p x = 0" by (auto simp: t_def)

  from rs have C: "s*t*d' = d * (1 - r*t - s*pderiv t)"
      by (simp add: A B algebra_simps pderiv_mult)
  from assms have [simp]: "p \<noteq> 0" "d \<noteq> 0" "t \<noteq> 0"
      by (force, force, subst (asm) A, force)

  have "\<And>x. \<lbrakk>x dvd t; x dvd (pderiv t)\<rbrakk> \<Longrightarrow> x dvd 1"
  proof-
    fix x assume "x dvd t" "x dvd (pderiv t)"
    then obtain v w where vw:
        "t = x*v" "pderiv t = x*w" unfolding dvd_def by blast
    def [simp]: x' \<equiv> "pderiv x" and [simp]: v' \<equiv> "pderiv v"
    from vw have "x*v' + v*x' = x*w" by (simp add: pderiv_mult)
    hence "v*x' = x*(w - v')" by (simp add: algebra_simps)
    hence "x dvd v*pderiv x" by simp
    then obtain y where y: "v*x' = x*y" unfolding dvd_def by force
    from `t \<noteq> 0` and vw have "x \<noteq> 0" by simp

    have x_pow_n_dvd_d: "\<And>n. x^n dvd d"
    proof-
      fix n show "x ^ n dvd d"
      proof (induction n, simp, rename_tac n, case_tac n)
        fix n assume "n = (0::nat)"
        from vw and C have "d = x*(d*r*v + d*s*w + s*v*d')"
            by (simp add: algebra_simps)
        with `n = 0` show "x^Suc n dvd d" by (force intro: dvdI)
      next
        fix n n' assume IH: "x^n dvd d" and "n = Suc n'"
        hence [simp]: "Suc n' = n" "x * x^n' = x^n" by simp_all
        def c \<equiv> "[:of_nat n:] :: 'a poly"
        from pderiv_power_Suc[of x n']
            have [simp]: "pderiv (x^n) = c*x^n' * x'" unfolding c_def
            by (simp add: real_eq_of_nat)

        from IH obtain z where d: "d = x^n * z" unfolding dvd_def by blast
        def [simp]: z' \<equiv> "pderiv z"
        from d `d \<noteq> 0` have "x^n \<noteq> 0" "z \<noteq> 0" by force+
        from C d have "x^n*z = z*r*v*x^Suc n + z*s*c*x^n*(v*x') +
                          s*v*z'*x^Suc n + s*z*(v*x')*x^n + s*z*v'*x^Suc n"
            by (simp add: algebra_simps vw pderiv_mult)
        also have "... = x^n*x * (z*r*v + z*s*c*y + s*v*z' + s*z*y + s*z*v')"
            by (simp only: y, simp add: algebra_simps)
        finally have "z = x*(z*r*v+z*s*c*y+s*v*z'+s*z*y+s*z*v')"
             using `x^n \<noteq> 0` by force
        hence "x dvd z" by (metis dvd_triv_left)
        with d show "x^Suc n dvd d" by simp
     qed
   qed

   have "degree x = 0"
   proof (cases "degree x", simp)
     case (Suc n)
       hence "x \<noteq> 0" by auto
       with Suc have "degree (x ^ (Suc (degree d))) > degree d"
           by (subst degree_power_eq, simp_all)
       moreover from x_pow_n_dvd_d[of "Suc (degree d)"] and `d \<noteq> 0`
           have "degree (x^Suc (degree d)) \<le> degree d"
                by (simp add: dvd_imp_degree_le)
       ultimately show ?thesis by simp
    qed
    then obtain c where [simp]: "x = [:c:]" by (cases x, simp split: split_if_asm)
    moreover from `x \<noteq> 0` have "c \<noteq> 0" by simp
    ultimately show "x dvd 1" using dvdI[of 1 x "[:inverse c:]"]
        by (simp add: one_poly_def)
  qed

  thus "coprime t (pderiv t)"
      by (force intro: poly_gcd_unique[of 1 t "pderiv t"])
qed

text {*
  Dividing a polynomial by its gcd with its derivative yields
  a squarefree polynomial with the same roots.
*}
lemma poly_div_gcd_squarefree:
  assumes "(p :: ('a::real_normed_field) poly) \<noteq> 0"
  defines "d \<equiv> gcd p (pderiv p)"
  shows "coprime (p div d) (pderiv (p div d))" (is ?A) and
        "\<And>x. poly (p div d) x = 0 \<longleftrightarrow> poly p x = 0" (is "\<And>x. ?B x")
proof-
  have "?A \<and> (\<forall>x. ?B x)"
  proof (cases "pderiv p = 0")
    case False
      from poly_div_gcd_squarefree_aux[OF this] show ?thesis
          unfolding d_def by auto
  next
    case True
      then obtain c where [simp]: "p = [:c:]" using pderiv_iszero by blast
      from assms(1) have "c \<noteq> 0" by simp
      from True have "d = smult (inverse c) p"
          by (simp add: d_def gcd_poly.simps(1))
      hence "p div d = [:c:]" using `c \<noteq> 0`
          by (simp add: div_smult_right assms(1) one_poly_def[symmetric])
      thus ?thesis using `c \<noteq> 0`
        by (simp add: gcd_poly.simps(1) one_poly_def)
  qed
  thus ?A and "\<And>x. ?B x" by simp_all
qed

subsubsection {* Sign changes of a polynomial *}

text {*
  If a polynomial has different signs at two points, it has a root inbetween.
*}
lemma poly_different_sign_imp_root:
  assumes "a < b" and "sgn (poly p a) \<noteq> sgn (poly p (b::real))"
  shows "\<exists>x. a \<le> x \<and> x \<le> b \<and> poly p x = 0"
proof (cases "poly p a = 0 \<or> poly p b = 0")
  case True
    thus ?thesis using assms(1)
        by (elim disjE, rule_tac exI[of _ a], simp,
                        rule_tac exI[of _ b], simp)
next
  case False
    hence [simp]: "poly p a \<noteq> 0" "poly p b \<noteq> 0" by simp_all
    show ?thesis
    proof (cases "poly p a < 0")
      case True
        hence "sgn (poly p a) = -1" by simp
        with assms True have "poly p b > 0"
            by (auto simp: sgn_real_def split: split_if_asm)
        from poly_IVT_pos[OF `a < b` True this] guess x ..
        thus ?thesis by (intro exI[of _ x], simp)
    next
      case False
        hence "poly p a > 0" by (simp add: not_less less_eq_real_def)
        hence "sgn (poly p a) = 1"  by simp
        with assms False have "poly p b < 0"
            by (auto simp: sgn_real_def not_less
                           less_eq_real_def split: split_if_asm)
        from poly_IVT_neg[OF `a < b` `poly p a > 0` this] guess x ..
        thus ?thesis by (intro exI[of _ x], simp)
    qed
qed

lemma poly_different_sign_imp_root':
  assumes "sgn (poly p a) \<noteq> sgn (poly p (b::real))"
  shows "\<exists>x. poly p x = 0"
using assms by (cases "a < b", auto dest!: poly_different_sign_imp_root
                                    simp: less_eq_real_def not_less)

lemma no_roots_inbetween_imp_same_sign:
  assumes "a < b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> (0::real)"
  shows "sgn (poly p a) = sgn (poly p b)"
  using poly_different_sign_imp_root assms by auto

lemma no_roots_inbetween_imp_same_sign':
  assumes "a \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> (0::real)"
  shows "sgn (poly p a) = sgn (poly p b)"
  using assms by (cases "a = b") (auto intro!: no_roots_inbetween_imp_same_sign)

subsubsection {* Limits of polynomials *}

lemma poly_neighbourhood_without_roots:
  assumes "(p :: real poly) \<noteq> 0"
  shows "eventually (\<lambda>x. poly p x \<noteq> 0) (at x\<^sub>0)"
proof-
  {
    fix \<epsilon> :: real assume "\<epsilon> > 0"
    have fin: "finite {x. \<bar>x-x\<^sub>0\<bar> < \<epsilon> \<and> x \<noteq> x\<^sub>0 \<and> poly p x = 0}"
        using poly_roots_finite[OF assms] by simp
    with `\<epsilon> > 0`have "\<exists>\<delta>>0. \<delta>\<le>\<epsilon> \<and> (\<forall>x. \<bar>x-x\<^sub>0\<bar> < \<delta> \<and> x \<noteq> x\<^sub>0 \<longrightarrow> poly p x \<noteq> 0)"
    proof (induction "card {x. \<bar>x-x\<^sub>0\<bar> < \<epsilon> \<and> x \<noteq> x\<^sub>0 \<and> poly p x = 0}"
           arbitrary: \<epsilon> rule: less_induct)
    case (less \<epsilon>)
    let ?A = "{x. \<bar>x - x\<^sub>0\<bar> < \<epsilon> \<and> x \<noteq> x\<^sub>0 \<and> poly p x = 0}"
    show ?case
      proof (cases "card ?A")
      case 0
        hence "?A = {}" using less by auto
        thus ?thesis using less(2) by (rule_tac exI[of _ \<epsilon>], auto)
      next
      case (Suc _)
        with less(3) have "{x. \<bar>x - x\<^sub>0\<bar> < \<epsilon> \<and> x \<noteq> x\<^sub>0 \<and> poly p x = 0} \<noteq> {}" by force
        then obtain x where x_props: "\<bar>x - x\<^sub>0\<bar> < \<epsilon>" "x \<noteq> x\<^sub>0" "poly p x = 0" by blast
        def \<epsilon>' \<equiv> "\<bar>x - x\<^sub>0\<bar> / 2"
        have "\<epsilon>' > 0" "\<epsilon>' < \<epsilon>" unfolding \<epsilon>'_def using x_props by simp_all
        from x_props(1,2) and `\<epsilon> > 0`
            have "x \<notin> {x'. \<bar>x' - x\<^sub>0\<bar> < \<epsilon>' \<and> x' \<noteq> x\<^sub>0 \<and> poly p x' = 0}" (is "_ \<notin> ?B")
            by (auto simp: \<epsilon>'_def)
        moreover from x_props
            have "x \<in> {x. \<bar>x - x\<^sub>0\<bar> < \<epsilon> \<and> x \<noteq> x\<^sub>0 \<and> poly p x = 0}" by blast
        ultimately have "?B \<subset> ?A" by auto
        hence "card ?B < card ?A" "finite ?B"
            by (rule psubset_card_mono[OF less(3)],
                blast intro: finite_subset[OF _ less(3)])
        from less(1)[OF this(1) `\<epsilon>' > 0` this(2)]
            show ?thesis using `\<epsilon>' < \<epsilon>` by force
      qed
    qed
  }
  from this[of "1"]
    show ?thesis by (auto simp: eventually_at dist_real_def)
qed

lemma poly_neighbourhood_same_sign:
  assumes "poly p (x\<^sub>0 :: real) \<noteq> 0"
  shows "eventually (\<lambda>x. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)"
proof (rule eventually_mono)
  have cont: "isCont (\<lambda>x. sgn (poly p x)) x\<^sub>0"
      by (rule isCont_sgn, rule poly_isCont, rule assms)
  thus "eventually (\<lambda>x. \<bar>sgn (poly p x) - sgn (poly p x\<^sub>0)\<bar> < 1) (at x\<^sub>0)"
      by (auto simp: isCont_def tendsto_iff dist_real_def)
qed (auto simp add: sgn_real_def)

lemma poly_lhopital:
  assumes "poly p (x::real) = 0" "poly q x = 0" "q \<noteq> 0"
  assumes "(\<lambda>x. poly (pderiv p) x / poly (pderiv q) x) -- x --> y"
  shows "(\<lambda>x. poly p x / poly q x) -- x --> y"
using assms
proof (rule_tac lhopital)
  have "isCont (poly p) x" "isCont (poly q) x" by simp_all
  with assms(1,2) show "poly p -- x --> 0" "poly q -- x --> 0"
       by (simp_all add: isCont_def)
  from `q \<noteq> 0` and `poly q x = 0` have "pderiv q \<noteq> 0"
      by (auto dest: pderiv_iszero)
  from poly_neighbourhood_without_roots[OF this]
      show "eventually (\<lambda>x. poly (pderiv q) x \<noteq> 0) (at x)" .
qed (auto intro: poly_DERIV poly_neighbourhood_without_roots)

lemma poly_roots_bounds:
  assumes "p \<noteq> 0"
  obtains l u
  where "l \<le> (u :: real)"
    and "poly p l \<noteq> 0"
    and "poly p u \<noteq> 0"
    and "{x. x > l \<and> x \<le> u \<and> poly p x = 0 } = {x. poly p x = 0}"
    and "\<And>x. x \<le> l \<Longrightarrow> sgn (poly p x) = sgn (poly p l)"
    and "\<And>x. x \<ge> u \<Longrightarrow> sgn (poly p x) = sgn (poly p u)"
proof
  from assms have "finite {x. poly p x = 0}" (is "finite ?roots")
      using poly_roots_finite by fast
  let ?roots' = "insert 0 ?roots"

  def l \<equiv> "Min ?roots' - 1"
  def u \<equiv> "Max ?roots' + 1"

  from `finite ?roots` have A: "finite ?roots'"  by auto
  from Min_le[OF this, of 0] and Max_ge[OF this, of 0]
      show "l \<le>  u" by (simp add: l_def u_def)
  from Min_le[OF A] have l_props: "\<And>x. x\<le>l \<Longrightarrow> poly p x \<noteq> 0"
      by (fastforce simp: l_def)
  from Max_ge[OF A] have u_props: "\<And>x. x\<ge>u \<Longrightarrow> poly p x \<noteq> 0"
      by (fastforce simp: u_def)
  from l_props u_props show [simp]: "poly p l \<noteq> 0" "poly p u \<noteq> 0" by auto

  from l_props have "\<And>x. poly p x = 0 \<Longrightarrow> x > l" by (metis not_le)
  moreover from u_props have "\<And>x. poly p x = 0 \<Longrightarrow> x \<le> u" by (metis linear)
  ultimately show "{x. x > l \<and> x \<le> u \<and> poly p x = 0} = ?roots" by auto

  {
    fix x assume A: "x < l" "sgn (poly p x) \<noteq> sgn (poly p l)"
    with poly_IVT_pos[OF A(1), of p] poly_IVT_neg[OF A(1), of p] A(2)
        have False by (auto split: split_if_asm
                         simp: sgn_real_def l_props not_less less_eq_real_def)
  }
  thus "\<And>x. x \<le> l \<Longrightarrow> sgn (poly p x) = sgn (poly p l)"
      by (case_tac "x = l", auto simp: less_eq_real_def)

  {
    fix x assume A: "x > u" "sgn (poly p x) \<noteq> sgn (poly p u)"
    with u_props poly_IVT_neg[OF A(1), of p] poly_IVT_pos[OF A(1), of p] A(2)
        have False by (auto split: split_if_asm
                         simp: sgn_real_def l_props not_less less_eq_real_def)
  }
  thus "\<And>x. x \<ge> u \<Longrightarrow> sgn (poly p x) = sgn (poly p u)"
      by (case_tac "x = u", auto simp: less_eq_real_def)
qed

definition poly_inf :: "('a::real_normed_vector) poly \<Rightarrow> 'a" where
  "poly_inf p \<equiv> sgn (coeff p (degree p))"
definition poly_neg_inf :: "('a::real_normed_vector) poly \<Rightarrow> 'a" where
  "poly_neg_inf p \<equiv> if even (degree p) then sgn (coeff p (degree p))
                                       else -sgn (coeff p (degree p))"
lemma poly_inf_0_iff[simp]:
    "poly_inf p = 0 \<longleftrightarrow> p = 0" "poly_neg_inf p = 0 \<longleftrightarrow> p = 0"
    by (auto simp: poly_inf_def poly_neg_inf_def sgn_zero_iff)

lemma poly_inf_mult[simp]:
  fixes p :: "('a::real_normed_field) poly"
  shows "poly_inf (p*q) = poly_inf p * poly_inf q"
        "poly_neg_inf (p*q) = poly_neg_inf p * poly_neg_inf q"
unfolding poly_inf_def poly_neg_inf_def
by ((cases "p = 0 \<or> q = 0",auto simp: sgn_zero_iff
         degree_mult_eq[of p q] coeff_mult_degree_sum sgn_mult)[])+

lemma poly_neq_0_at_infinity:
  assumes "(p :: real poly) \<noteq> 0"
  shows "eventually (\<lambda>x. poly p x \<noteq> 0) at_infinity"
proof-
  from poly_roots_bounds[OF assms] guess l u .
  note lu_props = this
  def b \<equiv> "max (-l) u"
  show ?thesis
  proof (subst eventually_at_infinity, rule exI[of _ b], clarsimp)
    fix x assume A: "\<bar>x\<bar> \<ge> b" and B: "poly p x = 0"
    show False
    proof (cases "x \<ge> 0")
      case True
        with A have "x \<ge> u" unfolding b_def by simp
        with lu_props(3, 6) show False by (metis sgn_zero_iff B)
    next
      case False
        with A have "x \<le> l" unfolding b_def by simp
        with lu_props(2, 5) show False by (metis sgn_zero_iff B)
    qed
  qed
qed

lemma poly_limit_aux:
  fixes p :: "real poly"
  defines "n \<equiv> degree p"
  shows "((\<lambda>x. poly p x / x ^ n) ---> coeff p n) at_infinity"
proof (subst filterlim_cong, rule refl, rule refl)
  show "eventually (\<lambda>x. poly p x / x^n = (\<Sum>i\<le>n. coeff p i / x^(n-i)))
            at_infinity"
  proof (rule eventually_mono, clarify)
    show "eventually (\<lambda>x::real. x \<noteq> 0) at_infinity"
        by (simp add: eventually_at_infinity, rule exI[of _ 1], auto)
    fix x :: real assume [simp]: "x \<noteq> 0"
    show "poly p x / x ^ n = (\<Sum>i\<le>n. coeff p i / x ^ (n - i))"
        by (simp add: n_def setsum_divide_distrib power_diff poly_altdef)
  qed

  let ?a = "\<lambda>i. if i = n then coeff p n else 0"
  have "\<forall>i\<in>{..n}. ((\<lambda>x. coeff p i / x ^ (n - i)) ---> ?a i) at_infinity"
  proof
    fix i assume "i \<in> {..n}"
    hence "i \<le> n" by simp
    show "((\<lambda>x. coeff p i / x ^ (n - i)) ---> ?a i) at_infinity"
    proof (cases "i = n")
      case True
        thus ?thesis by (intro tendstoI, subst eventually_at_infinity,
                         intro exI[of _ 1], simp add: dist_real_def)
    next
      case False
        hence "n - i > 0" using `i \<le> n` by simp
        from tendsto_inverse_0 and divide_real_def[of 1]
            have "((\<lambda>x. 1 / x :: real) ---> 0) at_infinity" by simp
        from tendsto_power[OF this, of "n - i"]
            have "((\<lambda>x::real. 1 / x ^ (n - i)) ---> 0) at_infinity"
                using `n - i > 0` by (simp add: power_0_left power_one_over)
        from tendsto_mult_right_zero[OF this, of "coeff p i"]
            have "((\<lambda>x. coeff p i / x ^ (n - i)) ---> 0) at_infinity"
                by (simp add: field_simps)
        thus ?thesis using False by simp
    qed
  qed
  hence "((\<lambda>x. \<Sum>i\<le>n. coeff p i / x^(n-i)) ---> (\<Sum>i\<le>n. ?a i)) at_infinity"
      by (force intro: tendsto_setsum)
  also have "(\<Sum>i\<le>n. ?a i) = coeff p n" by (subst setsum.delta, simp_all)
  finally show "((\<lambda>x. \<Sum>i\<le>n. coeff p i / x^(n-i)) ---> coeff p n) at_infinity" .
qed

lemma poly_at_top_at_top:
  fixes p :: "real poly"
  assumes "degree p \<ge> 1" "coeff p (degree p) > 0"
  shows "LIM x at_top. poly p x :> at_top"
proof-
  let ?n = "degree p"
  def f \<equiv> "\<lambda>x::real. poly p x / x^?n" and g \<equiv> "\<lambda>x::real. x ^ ?n"

  from poly_limit_aux have "(f ---> coeff p (degree p)) at_top"
      using tendsto_mono at_top_le_at_infinity unfolding f_def by blast
  moreover from assms
      have "LIM x at_top. g x :> at_top"
        by (auto simp add: g_def intro!: filterlim_pow_at_top filterlim_ident)
  ultimately have "LIM x at_top. f x * g x :> at_top"
      using filterlim_tendsto_pos_mult_at_top assms by simp
  also have "eventually (\<lambda>x. f x * g x = poly p x) at_top"
      unfolding f_def g_def
      by (subst eventually_at_top_linorder, rule exI[of _ 1],
          simp add: poly_altdef field_simps setsum_right_distrib power_diff)
  note filterlim_cong[OF refl refl this]
  finally show ?thesis .
qed

lemma poly_at_bot_at_top:
  fixes p :: "real poly"
  assumes "degree p \<ge> 1" "coeff p (degree p) < 0"
  shows "LIM x at_top. poly p x :> at_bot"
proof-
  from poly_at_top_at_top[of "-p"] and assms
      have "LIM x at_top. -poly p x :> at_top" by simp
  thus ?thesis by (simp add: filterlim_uminus_at_bot)
qed

lemma poly_lim_inf:
  "eventually (\<lambda>x::real. sgn (poly p x) = poly_inf p) at_top"
proof (cases "degree p \<ge> 1")
  case False
    hence "degree p = 0" by simp
    then obtain c where "p = [:c:]" by (cases p, auto split: split_if_asm)
    thus ?thesis
        by (simp add: eventually_at_top_linorder poly_inf_def)
next
  case True
    note deg = this
    let ?lc = "coeff p (degree p)"
    from True have "?lc \<noteq> 0" by force
    show ?thesis
    proof (cases "?lc > 0")
      case True
        from poly_at_top_at_top[OF deg this]
          obtain x\<^sub>0 where "\<And>x. x \<ge> x\<^sub>0 \<Longrightarrow> poly p x \<ge> 1"
              by (fastforce simp: filterlim_at_top
                      eventually_at_top_linorder less_eq_real_def)
        hence "\<And>x. x \<ge> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = 1" by force
        thus ?thesis by (simp only: eventually_at_top_linorder poly_inf_def,
                             intro exI[of _ x\<^sub>0], simp add: True)
    next
      case False
        hence "?lc < 0" using `?lc \<noteq> 0` by linarith
        from poly_at_bot_at_top[OF deg this]
          obtain x\<^sub>0 where "\<And>x. x \<ge> x\<^sub>0 \<Longrightarrow> poly p x \<le> -1"
              by (fastforce simp: filterlim_at_bot
                      eventually_at_top_linorder less_eq_real_def)
        hence "\<And>x. x \<ge> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = -1" by force
        thus ?thesis by (simp only: eventually_at_top_linorder poly_inf_def,
                             intro exI[of _ x\<^sub>0], simp add: `?lc < 0`)
    qed
qed

lemma poly_at_top_or_bot_at_bot:
  fixes p :: "real poly"
  assumes "degree p \<ge> 1" "coeff p (degree p) > 0"
  shows "LIM x at_bot. poly p x :> (if even (degree p) then at_top else at_bot)"
proof-
  let ?n = "degree p"
  def f \<equiv> "\<lambda>x::real. poly p x / x ^ ?n" and g \<equiv> "\<lambda>x::real. x ^ ?n"

  from poly_limit_aux have "(f ---> coeff p (degree p)) at_bot"
      using tendsto_mono at_bot_le_at_infinity by (force simp: f_def)
  moreover from assms
      have "LIM x at_bot. g x :> (if even (degree p) then at_top else at_bot)"
        by (auto simp add: g_def split: split_if_asm intro: filterlim_pow_at_bot_even filterlim_pow_at_bot_odd filterlim_ident)
  ultimately have "LIM x at_bot. f x * g x :>
                      (if even ?n then at_top else at_bot)"
      by (auto simp: assms intro: filterlim_tendsto_pos_mult_at_top
                                  filterlim_tendsto_pos_mult_at_bot)
  also have "eventually (\<lambda>x. f x * g x = poly p x) at_bot"
      unfolding f_def g_def
      by (subst eventually_at_bot_linorder, rule exI[of _ "-1"],
          simp add: poly_altdef field_simps setsum_right_distrib power_diff)
  note filterlim_cong[OF refl refl this]
  finally show ?thesis .
qed

lemma poly_at_bot_or_top_at_bot:
  fixes p :: "real poly"
  assumes "degree p \<ge> 1" "coeff p (degree p) < 0"
  shows "LIM x at_bot. poly p x :> (if even (degree p) then at_bot else at_top)"
proof-
  from poly_at_top_or_bot_at_bot[of "-p"] and assms
      have "LIM x at_bot. -poly p x :>
                (if even (degree p) then at_top else at_bot)" by simp
  thus ?thesis by (auto simp: filterlim_uminus_at_bot)
qed

lemma poly_lim_neg_inf:
  "eventually (\<lambda>x::real. sgn (poly p x) = poly_neg_inf p) at_bot"
proof (cases "degree p \<ge> 1")
  case False
    hence "degree p = 0" by simp
    then obtain c where "p = [:c:]" by (cases p, auto split: split_if_asm)
    thus ?thesis
        by (simp add: eventually_at_bot_linorder poly_neg_inf_def)
next
  case True
    note deg = this
    let ?lc = "coeff p (degree p)"
    from True have "?lc \<noteq> 0" by force
    show ?thesis
    proof (cases "?lc > 0")
      case True
        note lc_pos = this
        show ?thesis
        proof (cases "even (degree p)")
          case True
            from poly_at_top_or_bot_at_bot[OF deg lc_pos] and True
              obtain x\<^sub>0 where "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> poly p x \<ge> 1"
                by (fastforce simp add: filterlim_at_top filterlim_at_bot
                        eventually_at_bot_linorder less_eq_real_def)
                hence "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = 1" by force
              thus ?thesis
                by (simp add: True eventually_at_bot_linorder poly_neg_inf_def,
                    intro exI[of _ x\<^sub>0], simp add: lc_pos)
       next
          case False
            from poly_at_top_or_bot_at_bot[OF deg lc_pos] and False
              obtain x\<^sub>0 where "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> poly p x \<le> -1"
                by (fastforce simp add: filterlim_at_bot
                        eventually_at_bot_linorder less_eq_real_def)
                hence "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = -1" by force
              thus ?thesis
                by (simp add: False eventually_at_bot_linorder poly_neg_inf_def,
                              intro exI[of _ x\<^sub>0], simp add: lc_pos)
      qed
    next
      case False
        hence lc_neg: "?lc < 0" using `?lc \<noteq> 0` by linarith
        show ?thesis
        proof (cases "even (degree p)")
          case True
            with poly_at_bot_or_top_at_bot[OF deg lc_neg]
              obtain x\<^sub>0 where "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> poly p x \<le> -1"
                  by (fastforce simp: filterlim_at_bot
                          eventually_at_bot_linorder less_eq_real_def)
              hence "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = -1" by force
              thus ?thesis
                by (simp only: True eventually_at_bot_linorder poly_neg_inf_def,
                               intro exI[of _ x\<^sub>0], simp add: lc_neg)
        next
          case False
            with poly_at_bot_or_top_at_bot[OF deg lc_neg]
              obtain x\<^sub>0 where "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> poly p x \<ge> 1"
                  by (fastforce simp: filterlim_at_top
                          eventually_at_bot_linorder less_eq_real_def)
              hence "\<And>x. x \<le> x\<^sub>0 \<Longrightarrow> sgn (poly p x) = 1" by force
              thus ?thesis
                by (simp only: False eventually_at_bot_linorder poly_neg_inf_def,
                               intro exI[of _ x\<^sub>0], simp add: lc_neg)
        qed
    qed
qed

subsubsection {* Signs of polynomials for sufficiently large values *}

lemma polys_inf_sign_thresholds:
  assumes "finite (ps :: real poly set)"
  obtains l u
  where "l \<le> u"
    and "\<And>p. \<lbrakk>p \<in> ps; p \<noteq> 0\<rbrakk> \<Longrightarrow>
              {x. l < x \<and> x \<le> u \<and> poly p x = 0} = {x. poly p x = 0}"
    and "\<And>p x. \<lbrakk>p \<in> ps; x \<ge> u\<rbrakk> \<Longrightarrow> sgn (poly p x) = poly_inf p"
    and "\<And>p x. \<lbrakk>p \<in> ps; x \<le> l\<rbrakk> \<Longrightarrow> sgn (poly p x) = poly_neg_inf p"
proof-
  case goal1
  have "\<exists>l u. l \<le> u \<and> (\<forall>p x. p \<in> ps \<and> x \<ge> u \<longrightarrow> sgn (poly p x) = poly_inf p) \<and>
              (\<forall>p x. p \<in> ps \<and> x \<le> l \<longrightarrow> sgn (poly p x) = poly_neg_inf p)"
      (is "\<exists>l u. ?P ps l u")
  proof (induction rule: finite_subset_induct[OF assms(1), where A = UNIV], simp)
    case goal1
      show ?case by (intro exI[of _ 42], simp)
  next
    case (goal2 p ps)
      from goal2(4) obtain l u where lu_props: "?P ps l u" by blast
      from poly_lim_inf obtain u'
          where u'_props: "\<forall>x\<ge>u'. sgn (poly p x) = poly_inf p"
          by (force simp add: eventually_at_top_linorder)
      from poly_lim_neg_inf obtain l'
          where l'_props: "\<forall>x\<le>l'. sgn (poly p x) = poly_neg_inf p"
          by (force simp add: eventually_at_bot_linorder)
      show ?case
          by (rule exI[of _ "min l l'"], rule exI[of _ "max u u'"],
              insert lu_props l'_props u'_props, auto)
  qed
  then obtain l u where lu_props: "l \<le> u"
        "\<And>p x. p \<in> ps \<Longrightarrow> u \<le> x \<Longrightarrow> sgn (poly p x) = poly_inf p"
        "\<And>p x. p \<in> ps \<Longrightarrow> x \<le> l \<Longrightarrow> sgn (poly p x) = poly_neg_inf p" by blast
  moreover {
    fix p x assume A: "p \<in> ps" "p \<noteq> 0" "poly p x = 0"
    from A have "l < x" "x < u"
        by (auto simp: not_le[symmetric] dest: lu_props(2,3))
  }
  note A = this
  have "\<And>p. p \<in> ps \<Longrightarrow> p \<noteq> 0 \<Longrightarrow>
                 {x. l < x \<and> x \<le> u \<and> poly p x = 0} = {x. poly p x = 0}"
      by (auto dest: A)

  from goal1[OF lu_props(1) this lu_props(2,3)] show thesis .
qed

subsubsection {* Positivity of polynomials *}

lemma poly_pos:
  "(\<forall>x::real. poly p x > 0) \<longleftrightarrow> poly_inf p = 1 \<and> (\<forall>x. poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x::real. poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. poly p x \<noteq> 0" by simp

  from poly_lim_inf obtain x where "sgn (poly p x) = poly_inf p"
      by (auto simp: eventually_at_top_linorder)
  with A show "poly_inf p = 1"
      by (simp add: sgn_real_def split: split_if_asm)
next
  assume "poly_inf p = 1 \<and> (\<forall>x. poly p x \<noteq> 0)"
  hence A: "poly_inf p = 1" and B: "(\<forall>x. poly p x \<noteq> 0)" by simp_all
  from poly_lim_inf obtain x where C: "sgn (poly p x) = poly_inf p"
      by (auto simp: eventually_at_top_linorder)
  show "\<forall>x. poly p x > 0"
  proof (rule ccontr)
    assume "\<not>(\<forall>x. poly p x > 0)"
    then obtain x' where "poly p x' \<le> 0" by (auto simp: not_less)
    with A and C have "sgn (poly p x') \<noteq> sgn (poly p x)"
        by (auto simp: sgn_real_def split: split_if_asm)
    from poly_different_sign_imp_root'[OF this] and B
        show False by blast
  qed
qed

lemma poly_pos_greater:
  "(\<forall>x::real. x > a \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    poly_inf p = 1 \<and> (\<forall>x. x > a \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x::real. x > a \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. x > a \<longrightarrow> poly p x \<noteq> 0" by auto

  from poly_lim_inf obtain x\<^sub>0 where
      "\<forall>x\<ge>x\<^sub>0. sgn (poly p x) = poly_inf p"
      by (auto simp: eventually_at_top_linorder)
  hence "poly_inf p = sgn (poly p (max x\<^sub>0 (a + 1)))" by simp
  also from A have "... = 1" by force
  finally show "poly_inf p = 1" .
next
  assume "poly_inf p = 1 \<and> (\<forall>x. x > a \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "poly_inf p = 1" and
        B: "(\<forall>x. x > a \<longrightarrow> poly p x \<noteq> 0)" by simp_all
  from poly_lim_inf obtain x\<^sub>0 where
      C: "\<forall>x\<ge>x\<^sub>0. sgn (poly p x) = poly_inf p"
      by (auto simp: eventually_at_top_linorder)
  hence "sgn (poly p (max x\<^sub>0 (a+1))) = poly_inf p" by simp
  with A have D: "sgn (poly p (max x\<^sub>0 (a+1))) = 1" by simp
  show "\<forall>x. x > a \<longrightarrow> poly p x > 0"
  proof (rule ccontr)
    assume "\<not>(\<forall>x. x > a \<longrightarrow> poly p x > 0)"
    then obtain x' where "x' > a" "poly p x' \<le> 0" by (auto simp: not_less)
    with A and D have E: "sgn (poly p x') \<noteq> sgn (poly p (max x\<^sub>0(a+1)))"
        by (auto simp: sgn_real_def split: split_if_asm)
    show False
        apply (cases x' "max x\<^sub>0 (a+1)" rule: linorder_cases)
        using B E `x' > a`
            apply (force dest!: poly_different_sign_imp_root[of _ _ p])+
        done
  qed
qed

lemma poly_pos_geq:
  "(\<forall>x::real. x \<ge> a \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    poly_inf p = 1 \<and> (\<forall>x. x \<ge> a \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x::real. x \<ge> a \<longrightarrow> poly p x > 0"
  hence "\<forall>x::real. x > a \<longrightarrow> poly p x > 0" by simp
  also note poly_pos_greater
  finally have "poly_inf p = 1" "(\<forall>x>a. poly p x \<noteq> 0)" by simp_all
  moreover from A have "poly p a > 0" by simp
  ultimately show "poly_inf p = 1" "\<forall>x\<ge>a. poly p x \<noteq> 0"
      by (auto simp: less_eq_real_def)
next
  assume "poly_inf p = 1 \<and> (\<forall>x. x \<ge> a \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "poly_inf p = 1" and
        B: "poly p a \<noteq> 0" and C: "\<forall>x>a. poly p x \<noteq> 0" by simp_all
  from A and C and poly_pos_greater have "\<forall>x>a. poly p x > 0" by simp
  moreover with B C poly_IVT_pos[of a "a+1" p] have "poly p a > 0" by force
  ultimately show "\<forall>x\<ge>a. poly p x > 0" by (auto simp: less_eq_real_def)
qed

lemma poly_pos_less:
  "(\<forall>x::real. x < a \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    poly_neg_inf p = 1 \<and> (\<forall>x. x < a \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x::real. x < a \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. x < a \<longrightarrow> poly p x \<noteq> 0" by auto

  from poly_lim_neg_inf obtain x\<^sub>0 where
      "\<forall>x\<le>x\<^sub>0. sgn (poly p x) = poly_neg_inf p"
      by (auto simp: eventually_at_bot_linorder)
  hence "poly_neg_inf p = sgn (poly p (min x\<^sub>0 (a - 1)))" by simp
  also from A have "... = 1" by force
  finally show "poly_neg_inf p = 1" .
next
  assume "poly_neg_inf p = 1 \<and> (\<forall>x. x < a \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "poly_neg_inf p = 1" and
        B: "(\<forall>x. x < a \<longrightarrow> poly p x \<noteq> 0)" by simp_all
  from poly_lim_neg_inf obtain x\<^sub>0 where
      C: "\<forall>x\<le>x\<^sub>0. sgn (poly p x) = poly_neg_inf p"
      by (auto simp: eventually_at_bot_linorder)
  hence "sgn (poly p (min x\<^sub>0 (a - 1))) = poly_neg_inf p" by simp
  with A have D: "sgn (poly p (min x\<^sub>0 (a - 1))) = 1" by simp
  show "\<forall>x. x < a \<longrightarrow> poly p x > 0"
  proof (rule ccontr)
    assume "\<not>(\<forall>x. x < a \<longrightarrow> poly p x > 0)"
    then obtain x' where "x' < a" "poly p x' \<le> 0" by (auto simp: not_less)
    with A and D have E: "sgn (poly p x') \<noteq> sgn (poly p (min x\<^sub>0 (a - 1)))"
        by (auto simp: sgn_real_def split: split_if_asm)
    show False
        apply (cases x' "min x\<^sub>0 (a - 1)" rule: linorder_cases)
        using B E `x' < a`
            apply (auto dest!: poly_different_sign_imp_root[of _ _ p])+
        done
  qed
qed

lemma poly_pos_leq:
  "(\<forall>x::real. x \<le> a \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    poly_neg_inf p = 1 \<and> (\<forall>x. x \<le> a \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x::real. x \<le> a \<longrightarrow> poly p x > 0"
  hence "\<forall>x::real. x < a \<longrightarrow> poly p x > 0" by simp
  also note poly_pos_less
  finally have "poly_neg_inf p = 1" "(\<forall>x<a. poly p x \<noteq> 0)" by simp_all
  moreover from A have "poly p a > 0" by simp
  ultimately show "poly_neg_inf p = 1" "\<forall>x\<le>a. poly p x \<noteq> 0"
      by (auto simp: less_eq_real_def)
next
  assume "poly_neg_inf p = 1 \<and> (\<forall>x. x \<le> a \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "poly_neg_inf p = 1" and
        B: "poly p a \<noteq> 0" and C: "\<forall>x<a. poly p x \<noteq> 0" by simp_all
  from A and C and poly_pos_less have "\<forall>x<a. poly p x > 0" by simp
  moreover with B C poly_IVT_neg[of "a - 1" a p] have "poly p a > 0" by force
  ultimately show "\<forall>x\<le>a. poly p x > 0" by (auto simp: less_eq_real_def)
qed

lemma poly_pos_between_less_less:
  "(\<forall>x::real. a < x \<and> x < b \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    (a \<ge> b \<or> poly p ((a+b)/2) > 0) \<and> (\<forall>x. a < x \<and> x < b \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x. a < x \<and> x < b \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. a < x \<and> x < b \<longrightarrow> poly p x \<noteq> 0" by auto
  from A show "a \<ge> b \<or> poly p ((a+b)/2) > 0" by (cases "a < b", auto)
next
  assume "(b \<le> a \<or> 0 < poly p ((a+b)/2)) \<and> (\<forall>x. a<x \<and> x<b \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "b \<le> a \<or> 0 < poly p ((a+b)/2)" and
        B: "\<forall>x. a<x \<and> x<b \<longrightarrow> poly p x \<noteq> 0" by simp_all
  show "\<forall>x. a < x \<and> x < b \<longrightarrow> poly p x > 0"
  proof (cases "a \<ge> b", simp, clarify, rule_tac ccontr,
         simp only: not_le not_less)
    fix x assume "a < b" "a < x" "x < b" "poly p x \<le> 0"
    with B have "poly p x < 0" by (simp add: less_eq_real_def)
    moreover from A and `a < b` have "poly p ((a+b)/2) > 0" by simp
    ultimately have "sgn (poly p x) \<noteq> sgn (poly p ((a+b)/2))" by simp
    thus False using B
       apply (cases x "(a+b)/2" rule: linorder_cases)
       apply (drule poly_different_sign_imp_root[of _ _ p], assumption,
              insert `a < b` `a < x` `x < b` , force) []
       apply simp
       apply (drule poly_different_sign_imp_root[of _ _ p], simp,
              insert `a < b` `a < x` `x < b` , force)
       done
  qed
qed

lemma poly_pos_between_less_leq:
  "(\<forall>x::real. a < x \<and> x \<le> b \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    (a \<ge> b \<or> poly p b > 0) \<and> (\<forall>x. a < x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x. a < x \<and> x \<le> b \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. a < x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> 0" by auto
  from A show "a \<ge> b \<or> poly p b > 0" by (cases "a < b", auto)
next
  assume "(b \<le> a \<or> 0 < poly p b) \<and> (\<forall>x. a<x \<and> x\<le>b \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "b \<le> a \<or> 0 < poly p b" and B: "\<forall>x. a<x \<and> x\<le>b \<longrightarrow> poly p x \<noteq> 0"
      by simp_all
  show "\<forall>x. a < x \<and> x \<le> b \<longrightarrow> poly p x > 0"
  proof (cases "a \<ge> b", simp, clarify, rule_tac ccontr,
         simp only: not_le not_less)
    fix x assume "a < b" "a < x" "x \<le> b" "poly p x \<le> 0"
    with B have "poly p x < 0" by (simp add: less_eq_real_def)
    moreover from A and `a < b` have "poly p b > 0" by simp
    ultimately have "x < b" using `x \<le> b` by (auto simp: less_eq_real_def)
    from `poly p x < 0` and `poly p b > 0`
        have "sgn (poly p x) \<noteq> sgn (poly p b)" by simp
    from poly_different_sign_imp_root[OF `x < b` this] and B and `x > a`
        show False by auto
  qed
qed

lemma poly_pos_between_leq_less:
  "(\<forall>x::real. a \<le> x \<and> x < b \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    (a \<ge> b \<or> poly p a > 0) \<and> (\<forall>x. a \<le> x \<and> x < b \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x. a \<le> x \<and> x < b \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. a \<le> x \<and> x < b \<longrightarrow> poly p x \<noteq> 0" by auto
  from A show "a \<ge> b \<or> poly p a > 0" by (cases "a < b", auto)
next
  assume "(b \<le> a \<or> 0 < poly p a) \<and> (\<forall>x. a\<le>x \<and> x<b \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "b \<le> a \<or> 0 < poly p a" and B: "\<forall>x. a\<le>x \<and> x<b \<longrightarrow> poly p x \<noteq> 0"
      by simp_all
  show "\<forall>x. a \<le> x \<and> x < b \<longrightarrow> poly p x > 0"
  proof (cases "a \<ge> b", simp, clarify, rule_tac ccontr,
         simp only: not_le not_less)
    fix x assume "a < b" "a \<le> x" "x < b" "poly p x \<le> 0"
    with B have "poly p x < 0" by (simp add: less_eq_real_def)
    moreover from A and `a < b` have "poly p a > 0" by simp
    ultimately have "x > a" using `x \<ge> a` by (auto simp: less_eq_real_def)
    from `poly p x < 0` and `poly p a > 0`
        have "sgn (poly p a) \<noteq> sgn (poly p x)" by simp
    from poly_different_sign_imp_root[OF `x > a` this] and B and `x < b`
        show False by auto
  qed
qed

lemma poly_pos_between_leq_leq:
  "(\<forall>x::real. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x > 0) \<longleftrightarrow>
    (a > b \<or> poly p a > 0) \<and> (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> 0)"
proof (intro iffI conjI)
  assume A: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x > 0"
  have "\<And>x. poly p (x::real) > 0 \<Longrightarrow> poly p x \<noteq> 0" by simp
  with A show "\<forall>x::real. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x \<noteq> 0" by auto
  from A show "a > b \<or> poly p a > 0" by (cases "a \<le> b", auto)
next
  assume "(b < a \<or> 0 < poly p a) \<and> (\<forall>x. a\<le>x \<and> x\<le>b \<longrightarrow> poly p x \<noteq> 0)"
  hence A: "b < a \<or> 0 < poly p a" and B: "\<forall>x. a\<le>x \<and> x\<le>b \<longrightarrow> poly p x \<noteq> 0"
      by simp_all
  show "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> poly p x > 0"
  proof (cases "a > b", simp, clarify, rule_tac ccontr,
         simp only: not_le not_less)
    fix x assume "a \<le> b" "a \<le> x" "x \<le> b" "poly p x \<le> 0"
    with B have "poly p x < 0" by (simp add: less_eq_real_def)
    moreover from A and `a \<le> b` have "poly p a > 0" by simp
    ultimately have "x > a" using `x \<ge> a` by (auto simp: less_eq_real_def)
    from `poly p x < 0` and `poly p a > 0`
        have "sgn (poly p a) \<noteq> sgn (poly p x)" by simp
    from poly_different_sign_imp_root[OF `x > a` this] and B and `x \<le> b`
        show False by auto
  qed
qed

end


theory RCPO
imports RC2 Porder Cont Fun_Cpo
begin

fun myBelow :: "'a::below rc \<Rightarrow> 'a rc \<Rightarrow> bool" where
  "myBelow (Leaf x) (Leaf y) = below x y" |
  "myBelow (Leaf x) (Node y l r) = below x y" |
  "myBelow (Node x l r) (Leaf y) = False" |
  "myBelow (Node x l r) (Node y l2 r2) = (below x y \<and> myBelow l l2 \<and> myBelow r r2)"

instantiation rc :: (below) below
begin
  definition below_rc_def [simp]:
    "(op \<sqsubseteq>) \<equiv> (\<lambda>x y . myBelow x y)"
  instance ..
end

lemma refl_less_rc: "(x::('a::po) rc) \<sqsubseteq> x"
  apply (induction x)
  apply simp
  apply auto
  done

lemma antisym_help: "myBelow (Node x l r) (y::('a::po) rc) \<Longrightarrow> myBelow y (Node x l r) \<Longrightarrow> (Node x l r) = y"
  apply (induction y rule:myBelow.induct)
  apply auto
  apply (metis below_antisym)
  apply (metis below_antisym)
  done

lemma antisym_less_rc: "(x::('a::po) rc) \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x = y"
  apply (induction x)
  apply auto
  apply (induction y)
  apply auto
  apply (metis below_antisym)
  apply (metis antisym_help)
  done

lemma trans_help: "myBelow (Leaf (y::('a::po))) ya \<Longrightarrow> myBelow ya (Leaf x) \<Longrightarrow> y \<sqsubseteq> x"
  apply (induction ya)
  apply auto
  apply (metis below_trans)
  done

lemma trans_help2: "(\<And>y. myBelow l2 y \<Longrightarrow> myBelow y l \<Longrightarrow> myBelow l2 l) \<Longrightarrow>
       myBelow (Node y l2 r2) ya \<Longrightarrow> myBelow ya (Node x l r) \<Longrightarrow> myBelow l2 l"
  apply (induction ya)
  apply auto
  done

lemma trans_help3: "(\<And>y. myBelow r2 y \<Longrightarrow> myBelow y r \<Longrightarrow> myBelow r2 r) \<Longrightarrow>
       myBelow (Node y l2 r2) ya \<Longrightarrow> myBelow ya (Node x l r) \<Longrightarrow> myBelow r2 r"
  apply (induction ya)
  apply auto
  done

lemma trans_less_rc: "(x::('a::po) rc) \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"
  apply (induction x arbitrary: y rule:myBelow.induct)
  apply auto
  apply (metis trans_help)
  apply (metis myBelow.simps(3) rc.exhaust)
  apply (metis (full_types) below_trans myBelow.simps(1) myBelow.simps(2) myBelow.simps(4) rc.distinct(1) rc.exhaust)
  apply (metis (full_types) below_refl box_below myBelow.simps(3) myBelow.simps(4) rc.exhaust)
  apply (metis trans_help2)
  apply (metis trans_help3)
  done

instantiation rc :: (po)po
begin
  instance
  apply intro_classes
  apply (metis refl_less_rc)
  apply (metis trans_less_rc)
  apply (metis antisym_less_rc)
  done
end

fun rc_order :: "('a::po) rc \<Rightarrow> bool" where
  "rc_order (Leaf x) = True" |
  "rc_order (Node x l r) = (x \<sqsubseteq> (getValue l []) \<and> x \<sqsubseteq> (getValue r []) \<and> rc_order l \<and> rc_order r)"

lemma getValue_order_help: "(\<And>xs. getValue l [] \<sqsubseteq> getValue l xs) \<Longrightarrow>
       (\<And>xs. getValue r [] \<sqsubseteq> getValue r xs) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       x \<sqsubseteq> getValue r [] \<Longrightarrow> rc_order l \<Longrightarrow> rc_order r \<Longrightarrow> x \<sqsubseteq> getValue (Node x l r) ys"
  apply (induction ys)
  apply auto
  apply (metis (full_types) below_refl box_below getValue.simps(3) getValue.simps(4))
  done

lemma getValue_order_help2: "x \<sqsubseteq> getValue t [] \<Longrightarrow> rc_order t \<Longrightarrow> x \<sqsubseteq> getValue t ys"
  apply (induction ys rule:getValue.induct)
  apply auto
  apply (metis below_trans)
  apply (metis below_trans)
  done

lemma getValue_order_help3: "rc_order x \<Longrightarrow> getValue x xs \<sqsubseteq> getValue x (xs @ ys)"
  apply (induction xs arbitrary: ys rule: getValue.induct)
  apply auto
  apply (induction ys)
  apply auto
  apply (metis (full_types) getValue.simps(2) getValue_order_help2 po_eq_conv rc_order.simps(2))
  done

lemma getValue_order_help4: "rc_order xa \<Longrightarrow>
       myBelow xa (Node x l r) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       x \<sqsubseteq> getValue r [] \<Longrightarrow> rc_order l \<Longrightarrow> rc_order r \<Longrightarrow> getValue xa [] \<sqsubseteq> x"
  apply (induction xa)
  apply (metis getValue.simps(1) myBelow.simps(2))
  apply (metis getValue.simps(2) myBelow.simps(4))
  done

lemma getValue_order_help5: "(\<And>x. rc_order x \<Longrightarrow> myBelow x l \<Longrightarrow> getValue x ys \<sqsubseteq> getValue l ys) \<Longrightarrow>
       rc_order xa \<Longrightarrow>
       myBelow xa (Node x l r) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       x \<sqsubseteq> getValue r [] \<Longrightarrow>
       rc_order l \<Longrightarrow> rc_order r \<Longrightarrow> getValue xa (False # ys) \<sqsubseteq> getValue l ys"
  apply (induction xa)
  apply auto
  apply (metis below_trans getValue_order_help2)
  done

lemma getValue_order_help6: "(\<And>x. rc_order x \<Longrightarrow> myBelow x r \<Longrightarrow> getValue x ys \<sqsubseteq> getValue r ys) \<Longrightarrow>
       rc_order xa \<Longrightarrow>
       myBelow xa (Node x l r) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       x \<sqsubseteq> getValue r [] \<Longrightarrow>
       rc_order l \<Longrightarrow> rc_order r \<Longrightarrow> getValue xa (True # ys) \<sqsubseteq> getValue r ys"
  apply (induction xa)
  apply auto
  apply (metis below_trans getValue_order_help2)
  done

lemma getValue_order: "rc_order x \<Longrightarrow> rc_order y \<Longrightarrow> myBelow x y \<Longrightarrow> getValue x xs \<sqsubseteq> getValue y xs"
  apply (induction xs arbitrary: x rule:getValue.induct)
  apply auto
  apply (metis getValue.simps(1) myBelow.simps(1) myBelow.simps(3) rc_order.cases)
  apply (metis getValue_order_help4)
  apply (metis getValue_order_help5)
  apply (metis getValue_order_help6)
  done

(* lemma getValue_monotone: "monofun (\<lambda>t. getValue t xs)"
  apply (simp only: monofun_def)
  apply auto
  apply (induction xs)
  apply (metis monohelp) *)

definition ordered :: "('a::po \<Rightarrow> 'a rc) \<Rightarrow> bool" where
  "ordered f = (\<forall>x.(rc_order (f x)))"

lemma getTree_ordered: "rc_order x \<Longrightarrow> rc_order (getTree x xs)"
  apply (induction x xs rule:getTree.induct)
  apply auto
  done

lemma getTree_order_help: "x \<sqsubseteq> getValue t [] \<Longrightarrow> myBelow (Leaf x) t"
  apply (metis getValue.simps(1) getValue.simps(2) myBelow.simps(1) myBelow.simps(2) rc.exhaust)
  done

lemma getTree_order_help2: "rc_order y \<Longrightarrow> myBelow (Leaf x) y \<Longrightarrow> myBelow (Leaf x) (getTree y ys)"
  apply (induction y ys rule:getTree.induct)
  apply auto
  apply (subgoal_tac "myBelow (Leaf x) l")
  apply auto
  apply (metis getTree_order_help rev_below_trans)
  apply (subgoal_tac "myBelow (Leaf x) r")
  apply auto
  apply (metis getTree_order_help rev_below_trans)
  done

lemma getTree_order: "rc_order x \<Longrightarrow> rc_order y \<Longrightarrow> myBelow x y \<Longrightarrow> getTree x xs \<sqsubseteq> getTree y xs"
  apply (induction y xs arbitrary: x rule:getTree.induct)
  apply auto
  apply (metis getTree.simps(1) myBelow.simps(3) rc.exhaust)
  apply (case_tac xa)
  apply auto
  apply (metis getTree.simps(1) getTree_order_help rc_order.simps(1) rev_below_trans)
  apply (case_tac xa)
  apply auto
  apply (metis getTree.simps(1) getTree_order_help rc_order.simps(1) rev_below_trans)
  done

lemma kleisli_order_help: "(\<And>xs. rc_order (kleisli f l xs)) \<Longrightarrow>
       \<forall>x y. x \<sqsubseteq> y \<longrightarrow> myBelow (f x) (f y) \<Longrightarrow>
       \<forall>x. rc_order (f x) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       rc_order l \<Longrightarrow>
       getValue (f x) xs \<sqsubseteq> getValue (kleisli f l (xs @ [b])) []"
  apply (induction l)
  apply auto
  apply (metis box_below getValTree getValue_order getValue_order_help3)
  apply (subgoal_tac "f x \<sqsubseteq> f a")
  apply (subgoal_tac "getValue (f x) xs \<sqsubseteq> getValue (f a) xs")
  apply (metis below_trans getValue_order_help3)
  apply (metis getValue_order)
  apply auto
  done

lemma kleisli_order: "monofun f \<Longrightarrow> ordered f \<Longrightarrow> rc_order x \<Longrightarrow> rc_order (kleisli f x xs)"
  apply (simp only: monofun_def)
  apply (simp only: ordered_def)
  apply auto
  apply (induction x arbitrary: xs rule:rc_order.induct)
  apply auto
  apply (metis getTree_ordered)
  apply (metis kleisli_order_help)
  apply (metis kleisli_order_help)
  done

lemma "monofun f \<Longrightarrow> ordered f \<Longrightarrow> rc_order x \<Longrightarrow> rc_order (flatMap f x)"
  apply (metis flatMap.simps kleisli_order)
  done

lemma order_myBelow: "x \<sqsubseteq> y \<Longrightarrow> myBelow x y"
  apply auto
  done

lemma "rc_order (f x) \<Longrightarrow> rc_order (f a) \<Longrightarrow> myBelow (f x) (f a) \<Longrightarrow> myBelow (getTree (f x) ys) (getTree (f a) ys)"
  apply (metis (hide_lams, mono_tags) getTree_order order_myBelow)
  done

lemma myBelow_alt: "getValue x [] \<sqsubseteq> y \<Longrightarrow> getTree x [False] \<sqsubseteq> l \<Longrightarrow> getTree x [True] \<sqsubseteq> r \<Longrightarrow> myBelow x (Node y l r)"
  apply auto
  apply (induction x)
  apply auto
  done

lemma kleisli_monotone_help: "(\<And>x. rc_order x \<Longrightarrow>
             myBelow x l \<Longrightarrow>
             myBelow (kleisli f x (word @ [False])) (kleisli f l (word @ [False]))) \<Longrightarrow>
       (\<And>x. rc_order x \<Longrightarrow>
             myBelow x r \<Longrightarrow>
             myBelow (kleisli f x (word @ [True])) (kleisli f r (word @ [True]))) \<Longrightarrow>
       \<forall>x y. x \<sqsubseteq> y \<longrightarrow> myBelow (f x) (f y) \<Longrightarrow>
       \<forall>x. rc_order (f x) \<Longrightarrow>
       rc_order xa \<Longrightarrow>
       myBelow xa (Node x l r) \<Longrightarrow>
       x \<sqsubseteq> getValue l [] \<Longrightarrow>
       x \<sqsubseteq> getValue r [] \<Longrightarrow>
       rc_order l \<Longrightarrow>
       rc_order r \<Longrightarrow>
       myBelow (kleisli f xa word)
        (Node (getValue (f x) word) (kleisli f l (word @ [False]))
          (kleisli f r (word @ [True])))"
  apply (induction xa)
  apply auto
  apply (rule myBelow_alt)
  apply auto
  apply (metis getValKleisli getValue.simps(1) getValue.simps(2) getValue_order kleisli.simps(1) kleisli.simps(2))
  apply (metis (hide_lams, no_types) below_trans getTree_order_help kleisli.simps(1) po_eq_conv rc_order.simps(1))
  apply (metis (hide_lams, no_types) below_trans getTree_order_help kleisli.simps(1) po_eq_conv rc_order.simps(1))
  apply (metis getValue_order)
  done

lemma kleisli_monotone: "\<forall>x y. x \<sqsubseteq> y \<longrightarrow> myBelow (f x) (f y) \<Longrightarrow>
    \<forall>x. rc_order (f x) \<Longrightarrow>
    rc_order x \<Longrightarrow>
    rc_order y \<Longrightarrow> myBelow x y \<Longrightarrow> myBelow (kleisli f x xs) (kleisli f y xs)"
  apply (induction f y xs arbitrary: x rule:kleisli.induct)
  apply auto
  apply (case_tac xa)
  apply auto
  apply (metis getTree_order order_myBelow)
  apply (metis kleisli_monotone_help)
  done

lemma "monofun f \<Longrightarrow> ordered f \<Longrightarrow> rc_order x \<Longrightarrow> rc_order y \<Longrightarrow> myBelow x y \<Longrightarrow> myBelow (flatMap f x) (flatMap f y)"
  apply (simp only: monofun_def)
  apply (simp only: ordered_def)
  apply auto
  by (metis kleisli_monotone)


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

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

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun take :: "Nat => 'a list => 'a list" where
  "take (Z) z = nil2"
| "take (S z2) (nil2) = nil2"
| "take (S z2) (cons2 x2 x3) = cons2 x2 (take z2 x3)"

fun len :: "'a list => Nat" where
  "len (nil2) = Z"
| "len (cons2 z xs) = S (len xs)"

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

theorem property0 :
  "((take n (x xs ys)) = (x (take n xs) (take (t2 n (len xs)) ys)))"
  oops

end