(*:maxLineLen=78:*)

chapter \<open> Probability Logic \label{chapter:probability} \<close>

theory Probability_Logic
  imports
    "../../Logic/Classical/Classical_Connectives"
    HOL.Real
    "HOL-Library.Countable"
begin

sledgehammer_params [smt_proofs = false]

section \<open> Definition of Probability Logic \label{sec:definition-of-probability-logic} \<close>

text \<open> Probability logic is defined in terms of an operator over
       classical logic obeying certain postulates. Scholars often credit
       George Boole for first conceiving this kind of formulation @{cite booleChapterXVITheory1853}.
       Theodore Hailperin in particular has written extensively on this subject
       @{cite hailperinProbabilityLogic1984
         and hailperinBooleLogicProbability1986
         and hailperinSententialProbabilityLogic1996}. \<close>

text \<open> The presentation below roughly follows Kolmogorov's axiomatization
       @{cite kolmogoroffChapterElementareWahrscheinlichkeitsrechnung1933}.
       A key difference is that we only require \<^emph>\<open>finite additivity\<close>, rather
       than \<^emph>\<open>countable additivity\<close>. Finite additivity is also defined in
       terms of \<^term>\<open>(\<rightarrow>)\<close>. This formulation is required so that
       probability logic may be extended to Boolean algebra in \S\ref{subsec:boolean-algebra-probability}. \<close>

class probability_logic = classical_logic +
  fixes Pr :: "'a \<Rightarrow> real"
  assumes probability_non_negative: "Pr \<phi> \<ge> 0"
  assumes probability_unity: "\<turnstile> \<phi> \<Longrightarrow> Pr \<phi> = 1"
  assumes probability_implicational_additivity:
    "\<turnstile> \<phi> \<rightarrow> \<psi> \<rightarrow> \<bottom> \<Longrightarrow> Pr ((\<phi> \<rightarrow> \<bottom>) \<rightarrow> \<psi>) = Pr \<phi> + Pr \<psi>"

text \<open> A similar axiomatization may be credited to
       Rescher @{cite \<open>pg. 185\<close> rescherManyvaluedLogic1969}.
       However, our formulation has fewer axioms.
       While Rescher assumes \<^term>\<open>\<turnstile> \<phi> \<leftrightarrow> \<psi> \<Longrightarrow> Pr \<phi> = Pr \<psi>\<close>, we
       provide it as a lemma in \S\ref{subsec:prob-logic-alt-def}. \<close>

subsection \<open> Why Finite Additivity? \label{subsection:why finite additivity}\<close>

text \<open> In this section we touch on why we have chosen to
       employ finite additivity in our axiomatization of
       @{class probability_logic} and deviate from conventional
       probability theory. \<close>

text \<open> Conventional probability obeys an axiom known as \<^emph>\<open>countable additivity\<close>.
       Traditionally it states if \<open>?S\<close> is a countable set of sets which are
       pairwise disjoint, then the limit \<open>\<Sum> s \<in> ?S. Pr s\<close> exists and
       \<open>Pr (\<Union> ?S) = (\<Sum> s \<in> ?S. Pr s)\<close>. This is more powerful than our
       finite additivity axiom
       @{lemma \<open>\<turnstile> \<phi> \<rightarrow> \<psi> \<rightarrow> \<bottom> \<Longrightarrow> Pr ((\<phi> \<rightarrow> \<bottom>) \<rightarrow> \<psi>) = Pr \<phi> + Pr \<psi>\<close>
          by (metis probability_implicational_additivity) }. \<close>

text \<open> However, we argue that demanding countable additivity is not practical.
       It prohibits data structures we would naturally use in programs
       exploiting the Dutch book theorem from Chapter \ref{chap:dutch-book-theorem}. \<close>

text \<open> Historically, the statisticians Bruno di Finetti and Leonard Savage
       gave the most well known critiques.  In @{cite definettiSuiPassaggiLimite1930}
       di Finetti shows various properties which are true for countably additive
       probability measures may not hold for finitely additive measures.
       Savage @{cite savageDifficultiesTheoryPersonal1967}, on the other hand,
       develops probability based on choices prizes in lotteries. \<close>

text \<open> We instead argue that if we demand countable additivity, then certain
       properties of real world financial software would no longer be formally
       verifiable as we demonstrate here. In particular, it prohibits data
       structures we would naturally use in programs exploiting the Dutch book
       theorem from Chapter \ref{chap:dutch-book-theorem}.
       Our argument is derivative of one given by Giangiacomo Gerla
       @{cite \<open>Section 3\<close> gerlaInferencesProbabilityLogic1994}. \<close>

text \<open> By taking equivalence classes modulo \<^term>\<open>\<lambda> \<phi> \<psi> . \<turnstile> \<phi> \<leftrightarrow> \<psi>\<close>,
       any classical logic instance gives rise to a Boolean algebra known as
       a \<^emph>\<open>Lindenbaum Algebra\<close>. In the case of @{typ "'a classical_propositional_formula"}
       this Boolean algebra algebra is both countable and \<^emph>\<open>atomless\<close>.
       A theorem of Horn and Tarski @{cite \<open>Theorem 3.2\<close> hornMeasuresBooleanAlgebras1948}
       asserts there can be no countable additive \<^term>\<open>Pr\<close> for a countable
       atomless Boolean algebra. \<close>

text \<open> A software trading system could reasonably use data structures
       just like @{typ "'nat classical_propositional_formula"} when analyzing
       fixed odds gambling markets. We go into detail regarding this in
       \S\ref{sec:fixed-odds-markets}.  Both \<^emph>\<open>Haskell\<close> and
       \<^emph>\<open>Rust\<close> allow for declaring data types like @{typ "'a classical_propositional_formula"}.
       These languages share a heritage from the ML family of languages just
       like Isabelle/HOL. \<close>

text \<open> Hence, if we insist on countably additivity then the Dutch Book theorem
       presented in \S\ref{subsec:probability-dutch-book} cannot be obtained
       for certain programs we may reasonably wish to write. Not only
       is our formulation in @{class probability_logic} suitable for
       obtaining the Dutch book theorem, so demanding countable additivity
       is unreasonable. \<close>

text \<open> The above argument is not intended as a blanket refutation of conventional
       probability theory. It is simply an impossibility result with respect
       to our Dutch book theorem. Plenty of classic results in probability
       rely on countable additivity. A nice example recently formalized in
       Isabelle/HOL is Bouffon's needle @{cite eberlBuffonNeedleProblem2017}. \<close>

subsection \<open> Basic Properties of Probability Logic \<close>

lemma (in probability_logic) probability_additivity:
  assumes "\<turnstile> \<sim> (\<phi> \<sqinter> \<psi>)"
  shows "Pr (\<phi> \<squnion> \<psi>) = Pr \<phi> + Pr \<psi>"
  using
    assms
  unfolding
    conjunction_def
    disjunction_def
    negation_def
  by (simp add: probability_implicational_additivity)

lemma (in probability_logic) probability_alternate_additivity:
  assumes "\<turnstile> \<phi> \<rightarrow> \<psi> \<rightarrow> \<bottom>"
  shows "Pr (\<phi> \<squnion> \<psi>) = Pr \<phi> + Pr \<psi>"
  using assms
  by (metis
        probability_additivity
        double_negation_converse
        modus_ponens
        conjunction_def
        negation_def)

lemma (in probability_logic) complementation:
  "Pr (\<sim> \<phi>) = 1 - Pr \<phi>"
  by (metis
        probability_alternate_additivity
        probability_unity
        bivalence
        negation_elimination
        add.commute
        add_diff_cancel_left')

lemma (in probability_logic) unity_upper_bound:
  "Pr \<phi> \<le> 1"
  by (metis
        (no_types)
        diff_ge_0_iff_ge
        probability_non_negative
        complementation)

subsection \<open> Alternate Definition of Probability Logic \label{subsec:prob-logic-alt-def} \<close>

text \<open> There is an alternate axiomatization of logical probability,
       due to Brian Gaines @{cite \<open>pg. 159, postulates P7, P8, and P8\<close> gainesFuzzyProbabilityUncertainty1978}
       and independently formulated by Brian Weatherson @{cite weathersonClassicalIntuitionisticProbability2003}.
       As Weatherson notes, this axiomatization is suited to formulating
       \<^emph>\<open>intuitionistic\<close> probability logic. In the case where the underlying
       logic is classical this is simply equivalent to the traditional
       axiomatization in \S\ref{sec:definition-of-probability-logic}. \<close>

class gaines_weatherson_probability = classical_logic +
  fixes Pr :: "'a \<Rightarrow> real"
  assumes gaines_weatherson_thesis:
    "Pr \<top> = 1"
  assumes gaines_weatherson_antithesis:
    "Pr \<bottom> = 0"
  assumes gaines_weatherson_monotonicity:
    "\<turnstile> \<phi> \<rightarrow> \<psi> \<Longrightarrow> Pr \<phi> \<le> Pr \<psi>"
  assumes gaines_weatherson_sum_rule:
    "Pr \<phi> + Pr \<psi> = Pr (\<phi> \<sqinter> \<psi>) + Pr (\<phi> \<squnion> \<psi>)"

sublocale gaines_weatherson_probability \<subseteq> probability_logic
proof
  fix \<phi>
  have "\<turnstile> \<bottom> \<rightarrow> \<phi>"
    by (simp add: ex_falso_quodlibet)
  thus "0 \<le> Pr \<phi>"
    using
      gaines_weatherson_antithesis
      gaines_weatherson_monotonicity
    by fastforce
next
  fix \<phi>
  assume "\<turnstile> \<phi>"
  thus "Pr \<phi> = 1"
    by (metis
          gaines_weatherson_thesis
          gaines_weatherson_monotonicity
          eq_iff
          axiom_k
          ex_falso_quodlibet
          modus_ponens
          verum_def)
next
  fix \<phi> \<psi>
  assume "\<turnstile> \<phi> \<rightarrow> \<psi> \<rightarrow> \<bottom>"
  hence "\<turnstile> \<sim> (\<phi> \<sqinter> \<psi>)"
    by (simp add: conjunction_def negation_def)
  thus "Pr ((\<phi> \<rightarrow> \<bottom>) \<rightarrow> \<psi>) = Pr \<phi> + Pr \<psi>"
    by (metis
          add.commute
          add.right_neutral
          eq_iff
          disjunction_def
          ex_falso_quodlibet
          negation_def
          gaines_weatherson_antithesis
          gaines_weatherson_monotonicity
          gaines_weatherson_sum_rule)
qed

lemma (in probability_logic) monotonicity:
  "\<turnstile> \<phi> \<rightarrow> \<psi> \<Longrightarrow> Pr \<phi> \<le> Pr \<psi>"
proof -
  assume "\<turnstile> \<phi> \<rightarrow> \<psi>"
  hence "\<turnstile> \<sim> (\<phi> \<sqinter> \<sim> \<psi>)"
    unfolding negation_def conjunction_def
    by (metis
          conjunction_def
          exclusion_contrapositive_equivalence
          negation_def
          weak_biconditional_weaken)
  hence "Pr (\<phi> \<squnion> \<sim> \<psi>) = Pr \<phi> + Pr (\<sim> \<psi>)"
    by (simp add: probability_additivity)
  hence "Pr \<phi> + Pr (\<sim> \<psi>) \<le> 1"
    by (metis unity_upper_bound)
  hence "Pr \<phi> + 1 - Pr \<psi> \<le> 1"
    by (simp add: complementation)
  thus ?thesis by linarith
qed

lemma (in probability_logic) biconditional_equivalence:
  "\<turnstile> \<phi> \<leftrightarrow> \<psi> \<Longrightarrow> Pr \<phi> = Pr \<psi>"
  by (meson
        eq_iff
        modus_ponens
        biconditional_left_elimination
        biconditional_right_elimination
        monotonicity)

lemma (in probability_logic) sum_rule:
  "Pr (\<phi> \<squnion> \<psi>) + Pr (\<phi> \<sqinter> \<psi>) = Pr \<phi> + Pr \<psi>"
proof -
  have "\<turnstile> (\<phi> \<squnion> \<psi>) \<leftrightarrow> (\<phi> \<squnion> \<psi> \<setminus> (\<phi> \<sqinter> \<psi>))"
  proof -
    have "\<forall> \<MM>. \<MM> \<Turnstile>\<^sub>p\<^sub>r\<^sub>o\<^sub>p (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<squnion> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<leftrightarrow> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<squnion> \<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>))"
      unfolding
        classical_logic_class.subtraction_def
        classical_logic_class.negation_def
        classical_logic_class.biconditional_def
        classical_logic_class.conjunction_def
        classical_logic_class.disjunction_def
      by simp
    hence "\<turnstile> \<^bold>\<lparr> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<squnion> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<leftrightarrow> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<squnion> \<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<^bold>\<rparr>"
      using propositional_semantics by blast
    thus ?thesis by simp
  qed
  moreover have "\<turnstile> \<phi> \<rightarrow> (\<psi> \<setminus> (\<phi> \<sqinter> \<psi>)) \<rightarrow> \<bottom>"
  proof -
    have "\<forall> \<MM>. \<MM> \<Turnstile>\<^sub>p\<^sub>r\<^sub>o\<^sub>p \<^bold>\<langle>\<phi>\<^bold>\<rangle> \<rightarrow> (\<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<rightarrow> \<bottom>"
      unfolding
        classical_logic_class.subtraction_def
        classical_logic_class.negation_def
        classical_logic_class.biconditional_def
        classical_logic_class.conjunction_def
        classical_logic_class.disjunction_def
      by simp
    hence "\<turnstile> \<^bold>\<lparr> \<^bold>\<langle>\<phi>\<^bold>\<rangle> \<rightarrow> (\<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<rightarrow> \<bottom> \<^bold>\<rparr>"
      using propositional_semantics by blast
    thus ?thesis by simp
  qed
  hence "Pr (\<phi> \<squnion> \<psi>) = Pr \<phi> + Pr (\<psi> \<setminus> (\<phi> \<sqinter> \<psi>))"
    using
      probability_alternate_additivity
      biconditional_equivalence
      calculation
    by auto
  moreover have "\<turnstile> \<psi> \<leftrightarrow> (\<psi> \<setminus> (\<phi> \<sqinter> \<psi>) \<squnion> (\<phi> \<sqinter> \<psi>))"
  proof -
    have "\<forall> \<MM>. \<MM> \<Turnstile>\<^sub>p\<^sub>r\<^sub>o\<^sub>p \<^bold>\<langle>\<psi>\<^bold>\<rangle> \<leftrightarrow> (\<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<squnion> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>))"
      unfolding
        classical_logic_class.subtraction_def
        classical_logic_class.negation_def
        classical_logic_class.biconditional_def
        classical_logic_class.conjunction_def
        classical_logic_class.disjunction_def
      by auto
    hence "\<turnstile> \<^bold>\<lparr> \<^bold>\<langle>\<psi>\<^bold>\<rangle> \<leftrightarrow> (\<^bold>\<langle>\<psi>\<^bold>\<rangle> \<setminus> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<squnion> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<^bold>\<rparr>"
      using propositional_semantics by
      blast
    thus ?thesis by simp
  qed
  moreover have "\<turnstile> (\<psi> \<setminus> (\<phi> \<sqinter> \<psi>)) \<rightarrow> (\<phi> \<sqinter> \<psi>) \<rightarrow> \<bottom>"
    unfolding
      subtraction_def
      negation_def
      conjunction_def
    using
      conjunction_def
      conjunction_right_elimination
    by auto
  hence "Pr \<psi> = Pr (\<psi> \<setminus> (\<phi> \<sqinter> \<psi>)) + Pr (\<phi> \<sqinter> \<psi>)"
    using
      probability_alternate_additivity
      biconditional_equivalence
      calculation
    by auto
  ultimately show ?thesis
    by simp
qed

sublocale probability_logic \<subseteq> gaines_weatherson_probability
proof
  show "Pr \<top> = 1"
    by (simp add: probability_unity)
next
  show "Pr \<bottom> = 0"
    by (metis
          add_cancel_left_right
          probability_additivity
          ex_falso_quodlibet
          probability_unity
          bivalence
          conjunction_right_elimination
          negation_def)
next
  fix \<phi> \<psi>
  assume "\<turnstile> \<phi> \<rightarrow> \<psi>"
  thus "Pr \<phi> \<le> Pr \<psi>"
    using monotonicity
    by auto
next
  fix \<phi> \<psi>
  show "Pr \<phi> + Pr \<psi> = Pr (\<phi> \<sqinter> \<psi>) + Pr (\<phi> \<squnion> \<psi>)"
    by (metis sum_rule add.commute)
qed

sublocale probability_logic \<subseteq> consistent_classical_logic
proof
  show "\<not> \<turnstile> \<bottom>" using probability_unity gaines_weatherson_antithesis by auto
qed

lemma (in probability_logic) subtraction_identity:
  "Pr (\<phi> \<setminus> \<psi>) = Pr \<phi> - Pr (\<phi> \<sqinter> \<psi>)"
proof -
  have "\<turnstile> \<phi> \<leftrightarrow> ((\<phi> \<setminus> \<psi>) \<squnion> (\<phi> \<sqinter> \<psi>))"
  proof -
    have "\<forall> \<MM>. \<MM> \<Turnstile>\<^sub>p\<^sub>r\<^sub>o\<^sub>p \<^bold>\<langle>\<phi>\<^bold>\<rangle> \<leftrightarrow> ((\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<setminus> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<squnion> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>))"
      unfolding
        classical_logic_class.subtraction_def
        classical_logic_class.negation_def
        classical_logic_class.biconditional_def
        classical_logic_class.conjunction_def
        classical_logic_class.disjunction_def
      by (simp, blast)
    hence "\<turnstile> \<^bold>\<lparr> \<^bold>\<langle>\<phi>\<^bold>\<rangle> \<leftrightarrow> ((\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<setminus> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<squnion> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<^bold>\<rparr>"
      using propositional_semantics by blast
    thus ?thesis by simp
  qed
  hence "Pr \<phi>  = Pr ((\<phi> \<setminus> \<psi>) \<squnion> (\<phi> \<sqinter> \<psi>))"
    using biconditional_equivalence
    by simp
  moreover have "\<turnstile> \<sim>((\<phi> \<setminus> \<psi>) \<sqinter> (\<phi> \<sqinter> \<psi>))"
  proof -
    have "\<forall> \<MM>. \<MM> \<Turnstile>\<^sub>p\<^sub>r\<^sub>o\<^sub>p \<sim>((\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<setminus> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<sqinter> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>))"
      unfolding
        classical_logic_class.subtraction_def
        classical_logic_class.negation_def
        classical_logic_class.conjunction_def
        classical_logic_class.disjunction_def
      by simp
    hence "\<turnstile> \<^bold>\<lparr> \<sim>((\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<setminus> \<^bold>\<langle>\<psi>\<^bold>\<rangle>) \<sqinter> (\<^bold>\<langle>\<phi>\<^bold>\<rangle> \<sqinter> \<^bold>\<langle>\<psi>\<^bold>\<rangle>)) \<^bold>\<rparr>"
      using propositional_semantics by blast
    thus ?thesis by simp
  qed
  ultimately show ?thesis
    using probability_additivity
    by auto
qed

subsection \<open> Basic Probability Logic Inequality Results \label{subsec:basic-probability-inequality-results}\<close>

lemma (in probability_logic) disjunction_sum_inequality:
  "Pr (\<phi> \<squnion> \<psi>) \<le> Pr \<phi> + Pr \<psi>"
proof -
  have "Pr (\<phi> \<squnion> \<psi>) + Pr (\<phi> \<sqinter> \<psi>) = Pr \<phi> + Pr \<psi>"
       "0 \<le> Pr (\<phi> \<sqinter> \<psi>)"
    by (simp add: sum_rule, simp add: probability_non_negative)
  thus ?thesis by linarith
qed

lemma (in probability_logic)
  arbitrary_disjunction_list_summation_inequality:
  "Pr (\<Squnion> \<Phi>) \<le> (\<Sum>\<phi>\<leftarrow>\<Phi>. Pr \<phi>)"
proof (induct \<Phi>)
  case Nil
  then show ?case by (simp add: gaines_weatherson_antithesis)
next
  case (Cons \<phi> \<Phi>)
  have "Pr (\<Squnion> (\<phi> # \<Phi>)) \<le> Pr \<phi> + Pr (\<Squnion> \<Phi>)"
    using disjunction_sum_inequality
    by simp
  with Cons have "Pr (\<Squnion> (\<phi> # \<Phi>)) \<le> Pr \<phi> + (\<Sum>\<phi>\<leftarrow>\<Phi>. Pr \<phi>)" by linarith
  then show ?case by simp
qed

lemma (in probability_logic) implication_list_summation_inequality:
  assumes "\<turnstile> \<phi> \<rightarrow> \<Squnion> \<Psi>"
  shows "Pr \<phi> \<le> (\<Sum>\<psi>\<leftarrow>\<Psi>. Pr \<psi>)"
  using
    assms
    arbitrary_disjunction_list_summation_inequality
    monotonicity
    order_trans
  by blast

lemma (in probability_logic) arbitrary_disjunction_set_summation_inequality:
  "Pr (\<Squnion> \<Phi>) \<le> (\<Sum>\<phi> \<in> set \<Phi>. Pr \<phi>)"
  by (metis
        arbitrary_disjunction_list_summation_inequality
        arbitrary_disjunction_remdups
        biconditional_equivalence
        sum.set_conv_list)

lemma (in probability_logic) implication_set_summation_inequality:
  assumes "\<turnstile> \<phi> \<rightarrow> \<Squnion> \<Psi>"
  shows "Pr \<phi> \<le> (\<Sum>\<psi> \<in> set \<Psi>. Pr \<psi>)"
  using
    assms
    arbitrary_disjunction_set_summation_inequality
    monotonicity
    order_trans
  by blast

subsection \<open> Dirac Measures \label{subsec:dirac-measures}\<close>

text \<open> Before presenting \<^emph>\<open>Dirac measures\<close> in probability logic, we first
       give the set of all functions satisfying probability logic.\<close>

definition (in classical_logic) probabilities :: "('a \<Rightarrow> real) set"
  where "probabilities =
         {Pr. class.probability_logic (\<lambda> \<phi>. \<turnstile> \<phi>) (\<rightarrow>) \<bottom> Pr }"

text \<open> Traditionally, a Dirac measure is a function \<^term>\<open>\<delta>\<^sub>x\<close> where
       \<^term>\<open>\<delta>\<^sub>x(S) = (1::real)\<close> if \<^term>\<open>x \<in> S\<close> and \<^term>\<open>\<delta>\<^sub>x(S) = (0::real)\<close>
       otherwise.  This means that Dirac measures correspond to special
       ultrafilters on their underlying \<^term>\<open>\<sigma>\<close>-algebra which are
       closed under countable unions. \<close>

text \<open> Probability logic, as discussed in \S\ref{subsection:why finite additivity},
       may not have countable joins in its underlying logic. In the setting
       of probability logic, Dirac measures are simple probability functions
       that are either 0 or 1. \<close>

definition (in classical_logic) dirac_measures :: "('a \<Rightarrow> real) set"
  where "dirac_measures =
         { Pr. class.probability_logic (\<lambda> \<phi>. \<turnstile> \<phi>) (\<rightarrow>) \<bottom> Pr
               \<and> (\<forall>x. Pr x = 0 \<or> Pr x = 1) }"

lemma (in classical_logic) dirac_measures_subset:
  "dirac_measures \<subseteq> probabilities"
  unfolding
    probabilities_def
    dirac_measures_def
  by fastforce

text \<open> Maximally consistent sets correspond to Dirac measures.  One direction
       of this correspondence is established below. \<close>

lemma (in classical_logic) MCS_dirac_measure:
  assumes "MCS \<Omega>"
    shows "(\<lambda> \<chi>. if \<chi>\<in>\<Omega> then (1 :: real) else 0) \<in> dirac_measures"
      (is "?Pr \<in> dirac_measures")
proof -
  have "class.probability_logic (\<lambda> \<phi>. \<turnstile> \<phi>) (\<rightarrow>) \<bottom> ?Pr"
  proof (standard, simp,
         meson
           assms
           formula_maximally_consistent_set_def_reflection
           maximally_consistent_set_def
           set_deduction_weaken)
    fix \<phi> \<psi>
    assume "\<turnstile> \<phi> \<rightarrow> \<psi> \<rightarrow> \<bottom>"
    hence "\<phi> \<sqinter> \<psi> \<notin> \<Omega>"
      by (metis
            assms
            formula_consistent_def
            formula_maximally_consistent_set_def_def
            maximally_consistent_set_def
            conjunction_def
            set_deduction_modus_ponens
            set_deduction_reflection
            set_deduction_weaken)
    hence "\<phi> \<notin> \<Omega> \<or> \<psi> \<notin> \<Omega>"
      using
        assms
        formula_maximally_consistent_set_def_reflection
        maximally_consistent_set_def
        conjunction_set_deduction_equivalence
      by meson

    have "\<phi> \<squnion> \<psi> \<in> \<Omega> = (\<phi> \<in> \<Omega> \<or> \<psi> \<in> \<Omega>)"
      by (metis
            \<open>\<phi> \<sqinter> \<psi> \<notin> \<Omega>\<close>
            assms
            formula_maximally_consistent_set_def_implication
            maximally_consistent_set_def
            conjunction_def
            disjunction_def)
    have "?Pr (\<phi> \<squnion> \<psi>) = ?Pr \<phi> + ?Pr \<psi>"
    proof (cases "\<phi> \<squnion> \<psi> \<in> \<Omega>")
      case True
      hence \<diamondsuit>: "1 = ?Pr (\<phi> \<squnion> \<psi>)" by simp
      show ?thesis
      proof (cases "\<phi> \<in> \<Omega>")
        case True
        hence "\<psi> \<notin> \<Omega>"
          using \<open>\<phi> \<notin> \<Omega> \<or> \<psi> \<notin> \<Omega>\<close>
          by blast
        have "?Pr (\<phi> \<squnion> \<psi>) = (1::real)" using \<diamondsuit> by simp
        also have "... = 1 + (0::real)" by linarith
        also have "... = ?Pr \<phi> + ?Pr \<psi>"
          using \<open>\<psi> \<notin> \<Omega>\<close> \<open>\<phi> \<in> \<Omega>\<close> by simp
        finally show ?thesis .
      next
        case False
        hence "\<psi> \<in> \<Omega>"
          using \<open>\<phi> \<squnion> \<psi> \<in> \<Omega>\<close> \<open>(\<phi> \<squnion> \<psi> \<in> \<Omega>) = (\<phi> \<in> \<Omega> \<or> \<psi> \<in> \<Omega>)\<close>
          by blast
        have "?Pr (\<phi> \<squnion> \<psi>) = (1::real)" using \<diamondsuit> by simp
        also have "... = (0::real) + 1" by linarith
        also have "... = ?Pr \<phi> + ?Pr \<psi>"
          using \<open>\<psi> \<in> \<Omega>\<close> \<open>\<phi> \<notin> \<Omega>\<close> by simp
        finally show ?thesis .
      qed
    next
      case False
      moreover from this have "\<phi> \<notin> \<Omega>" "\<psi> \<notin> \<Omega>"
        using \<open>(\<phi> \<squnion> \<psi> \<in> \<Omega>) = (\<phi> \<in> \<Omega> \<or> \<psi> \<in> \<Omega>)\<close> by blast+
      ultimately show ?thesis by simp
    qed
    thus "?Pr ((\<phi> \<rightarrow> \<bottom>) \<rightarrow> \<psi>) = ?Pr \<phi> + ?Pr \<psi>"
      unfolding disjunction_def .
  qed
  thus ?thesis
    unfolding dirac_measures_def
    by simp
qed

end


(*  Title:      HOL/ex/Higher_Order_Logic.thy
    Author:     Gertrud Bauer and Markus Wenzel, TU Muenchen
*)

section \<open>Foundations of HOL\<close>

theory Higher_Order_Logic imports Pure begin

text \<open>
  The following theory development demonstrates Higher-Order Logic
  itself, represented directly within the Pure framework of Isabelle.
  The ``HOL'' logic given here is essentially that of Gordon
  @{cite "Gordon:1985:HOL"}, although we prefer to present basic concepts
  in a slightly more conventional manner oriented towards plain
  Natural Deduction.
\<close>

subsection \<open>Pure Logic\<close>

class type
default_sort type

typedecl o
instance o :: type ..
instance "fun" :: (type, type) type ..

subsubsection \<open>Basic logical connectives\<close>

judgment
  Trueprop :: "o \<Rightarrow> prop"    ("_" 5)

axiomatization
  imp :: "o \<Rightarrow> o \<Rightarrow> o"    (infixr "\<longrightarrow>" 25) and
  All :: "('a \<Rightarrow> o) \<Rightarrow> o"    (binder "\<forall>" 10)
where
  impI [intro]: "(A \<Longrightarrow> B) \<Longrightarrow> A \<longrightarrow> B" and
  impE [dest, trans]: "A \<longrightarrow> B \<Longrightarrow> A \<Longrightarrow> B" and
  allI [intro]: "(\<And>x. P x) \<Longrightarrow> \<forall>x. P x" and
  allE [dest]: "\<forall>x. P x \<Longrightarrow> P a"

subsubsection \<open>Extensional equality\<close>

axiomatization
  equal :: "'a \<Rightarrow> 'a \<Rightarrow> o"   (infixl "=" 50)
where
  refl [intro]: "x = x" and
  subst: "x = y \<Longrightarrow> P x \<Longrightarrow> P y"

axiomatization where
  ext [intro]: "(\<And>x. f x = g x) \<Longrightarrow> f = g" and
  iff [intro]: "(A \<Longrightarrow> B) \<Longrightarrow> (B \<Longrightarrow> A) \<Longrightarrow> A = B"

theorem sym [sym]: "x = y \<Longrightarrow> y = x"
proof -
  assume "x = y"
  then show "y = x" by (rule subst) (rule refl)
qed

lemma [trans]: "x = y \<Longrightarrow> P y \<Longrightarrow> P x"
  by (rule subst) (rule sym)

lemma [trans]: "P x \<Longrightarrow> x = y \<Longrightarrow> P y"
  by (rule subst)

theorem trans [trans]: "x = y \<Longrightarrow> y = z \<Longrightarrow> x = z"
  by (rule subst)

theorem iff1 [elim]: "A = B \<Longrightarrow> A \<Longrightarrow> B"
  by (rule subst)

theorem iff2 [elim]: "A = B \<Longrightarrow> B \<Longrightarrow> A"
  by (rule subst) (rule sym)

subsubsection \<open>Derived connectives\<close>

definition false :: o  ("\<bottom>") where "\<bottom> \<equiv> \<forall>A. A"

definition true :: o  ("\<top>") where "\<top> \<equiv> \<bottom> \<longrightarrow> \<bottom>"

definition not :: "o \<Rightarrow> o"  ("\<not> _" [40] 40)
  where "not \<equiv> \<lambda>A. A \<longrightarrow> \<bottom>"

definition conj :: "o \<Rightarrow> o \<Rightarrow> o"  (infixr "\<and>" 35)
  where "conj \<equiv> \<lambda>A B. \<forall>C. (A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> C"

definition disj :: "o \<Rightarrow> o \<Rightarrow> o"  (infixr "\<or>" 30)
  where "disj \<equiv> \<lambda>A B. \<forall>C. (A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"

definition Ex :: "('a \<Rightarrow> o) \<Rightarrow> o"  (binder "\<exists>" 10)
  where "\<exists>x. P x \<equiv> \<forall>C. (\<forall>x. P x \<longrightarrow> C) \<longrightarrow> C"

abbreviation not_equal :: "'a \<Rightarrow> 'a \<Rightarrow> o"  (infixl "\<noteq>" 50)
  where "x \<noteq> y \<equiv> \<not> (x = y)"

theorem falseE [elim]: "\<bottom> \<Longrightarrow> A"
proof (unfold false_def)
  assume "\<forall>A. A"
  then show A ..
qed

theorem trueI [intro]: \<top>
proof (unfold true_def)
  show "\<bottom> \<longrightarrow> \<bottom>" ..
qed

theorem notI [intro]: "(A \<Longrightarrow> \<bottom>) \<Longrightarrow> \<not> A"
proof (unfold not_def)
  assume "A \<Longrightarrow> \<bottom>"
  then show "A \<longrightarrow> \<bottom>" ..
qed

theorem notE [elim]: "\<not> A \<Longrightarrow> A \<Longrightarrow> B"
proof (unfold not_def)
  assume "A \<longrightarrow> \<bottom>"
  also assume A
  finally have \<bottom> ..
  then show B ..
qed

lemma notE': "A \<Longrightarrow> \<not> A \<Longrightarrow> B"
  by (rule notE)

lemmas contradiction = notE notE'  -- \<open>proof by contradiction in any order\<close>

theorem conjI [intro]: "A \<Longrightarrow> B \<Longrightarrow> A \<and> B"
proof (unfold conj_def)
  assume A and B
  show "\<forall>C. (A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> C"
  proof
    fix C show "(A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> C"
    proof
      assume "A \<longrightarrow> B \<longrightarrow> C"
      also note \<open>A\<close>
      also note \<open>B\<close>
      finally show C .
    qed
  qed
qed

theorem conjE [elim]: "A \<and> B \<Longrightarrow> (A \<Longrightarrow> B \<Longrightarrow> C) \<Longrightarrow> C"
proof (unfold conj_def)
  assume c: "\<forall>C. (A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> C"
  assume "A \<Longrightarrow> B \<Longrightarrow> C"
  moreover {
    from c have "(A \<longrightarrow> B \<longrightarrow> A) \<longrightarrow> A" ..
    also have "A \<longrightarrow> B \<longrightarrow> A"
    proof
      assume A
      then show "B \<longrightarrow> A" ..
    qed
    finally have A .
  } moreover {
    from c have "(A \<longrightarrow> B \<longrightarrow> B) \<longrightarrow> B" ..
    also have "A \<longrightarrow> B \<longrightarrow> B"
    proof
      show "B \<longrightarrow> B" ..
    qed
    finally have B .
  } ultimately show C .
qed

theorem disjI1 [intro]: "A \<Longrightarrow> A \<or> B"
proof (unfold disj_def)
  assume A
  show "\<forall>C. (A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"
  proof
    fix C show "(A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"
    proof
      assume "A \<longrightarrow> C"
      also note \<open>A\<close>
      finally have C .
      then show "(B \<longrightarrow> C) \<longrightarrow> C" ..
    qed
  qed
qed

theorem disjI2 [intro]: "B \<Longrightarrow> A \<or> B"
proof (unfold disj_def)
  assume B
  show "\<forall>C. (A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"
  proof
    fix C show "(A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"
    proof
      show "(B \<longrightarrow> C) \<longrightarrow> C"
      proof
        assume "B \<longrightarrow> C"
        also note \<open>B\<close>
        finally show C .
      qed
    qed
  qed
qed

theorem disjE [elim]: "A \<or> B \<Longrightarrow> (A \<Longrightarrow> C) \<Longrightarrow> (B \<Longrightarrow> C) \<Longrightarrow> C"
proof (unfold disj_def)
  assume c: "\<forall>C. (A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C"
  assume r1: "A \<Longrightarrow> C" and r2: "B \<Longrightarrow> C"
  from c have "(A \<longrightarrow> C) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> C" ..
  also have "A \<longrightarrow> C"
  proof
    assume A then show C by (rule r1)
  qed
  also have "B \<longrightarrow> C"
  proof
    assume B then show C by (rule r2)
  qed
  finally show C .
qed

theorem exI [intro]: "P a \<Longrightarrow> \<exists>x. P x"
proof (unfold Ex_def)
  assume "P a"
  show "\<forall>C. (\<forall>x. P x \<longrightarrow> C) \<longrightarrow> C"
  proof
    fix C show "(\<forall>x. P x \<longrightarrow> C) \<longrightarrow> C"
    proof
      assume "\<forall>x. P x \<longrightarrow> C"
      then have "P a \<longrightarrow> C" ..
      also note \<open>P a\<close>
      finally show C .
    qed
  qed
qed

theorem exE [elim]: "\<exists>x. P x \<Longrightarrow> (\<And>x. P x \<Longrightarrow> C) \<Longrightarrow> C"
proof (unfold Ex_def)
  assume c: "\<forall>C. (\<forall>x. P x \<longrightarrow> C) \<longrightarrow> C"
  assume r: "\<And>x. P x \<Longrightarrow> C"
  from c have "(\<forall>x. P x \<longrightarrow> C) \<longrightarrow> C" ..
  also have "\<forall>x. P x \<longrightarrow> C"
  proof
    fix x show "P x \<longrightarrow> C"
    proof
      assume "P x"
      then show C by (rule r)
    qed
  qed
  finally show C .
qed

subsection \<open>Classical logic\<close>

locale classical =
  assumes classical: "(\<not> A \<Longrightarrow> A) \<Longrightarrow> A"

theorem (in classical)
  Peirce's_Law: "((A \<longrightarrow> B) \<longrightarrow> A) \<longrightarrow> A"
proof
  assume a: "(A \<longrightarrow> B) \<longrightarrow> A"
  show A
  proof (rule classical)
    assume "\<not> A"
    have "A \<longrightarrow> B"
    proof
      assume A
      with \<open>\<not> A\<close> show B by (rule contradiction)
    qed
    with a show A ..
  qed
qed

theorem (in classical)
  double_negation: "\<not> \<not> A \<Longrightarrow> A"
proof -
  assume "\<not> \<not> A"
  show A
  proof (rule classical)
    assume "\<not> A"
    with \<open>\<not> \<not> A\<close> show ?thesis by (rule contradiction)
  qed
qed

theorem (in classical)
  tertium_non_datur: "A \<or> \<not> A"
proof (rule double_negation)
  show "\<not> \<not> (A \<or> \<not> A)"
  proof
    assume "\<not> (A \<or> \<not> A)"
    have "\<not> A"
    proof
      assume A then have "A \<or> \<not> A" ..
      with \<open>\<not> (A \<or> \<not> A)\<close> show \<bottom> by (rule contradiction)
    qed
    then have "A \<or> \<not> A" ..
    with \<open>\<not> (A \<or> \<not> A)\<close> show \<bottom> by (rule contradiction)
  qed
qed

theorem (in classical)
  classical_cases: "(A \<Longrightarrow> C) \<Longrightarrow> (\<not> A \<Longrightarrow> C) \<Longrightarrow> C"
proof -
  assume r1: "A \<Longrightarrow> C" and r2: "\<not> A \<Longrightarrow> C"
  from tertium_non_datur show C
  proof
    assume A
    then show ?thesis by (rule r1)
  next
    assume "\<not> A"
    then show ?thesis by (rule r2)
  qed
qed

lemma (in classical) "(\<not> A \<Longrightarrow> A) \<Longrightarrow> A"  (* FIXME *)
proof -
  assume r: "\<not> A \<Longrightarrow> A"
  show A
  proof (rule classical_cases)
    assume A then show A .
  next
    assume "\<not> A" then show A by (rule r)
  qed
qed

end


(*  Title:      HOL/Library/BigO.thy
    Authors:    Jeremy Avigad and Kevin Donnelly
*)

section {* Big O notation *}

theory BigO
imports Complex_Main Function_Algebras Set_Algebras
begin

text {*
This library is designed to support asymptotic ``big O'' calculations,
i.e.~reasoning with expressions of the form $f = O(g)$ and $f = g +
O(h)$.  An earlier version of this library is described in detail in
@{cite "Avigad-Donnelly"}.

The main changes in this version are as follows:
\begin{itemize}
\item We have eliminated the @{text O} operator on sets. (Most uses of this seem
  to be inessential.)
\item We no longer use @{text "+"} as output syntax for @{text "+o"}
\item Lemmas involving @{text "sumr"} have been replaced by more general lemmas
  involving `@{text "setsum"}.
\item The library has been expanded, with e.g.~support for expressions of
  the form @{text "f < g + O(h)"}.
\end{itemize}

Note also since the Big O library includes rules that demonstrate set
inclusion, to use the automated reasoners effectively with the library
one should redeclare the theorem @{text "subsetI"} as an intro rule,
rather than as an @{text "intro!"} rule, for example, using
\isa{\isakeyword{declare}}~@{text "subsetI [del, intro]"}.
*}

subsection {* Definitions *}

definition bigo :: "('a \<Rightarrow> 'b::linordered_idom) \<Rightarrow> ('a \<Rightarrow> 'b) set"  ("(1O'(_'))")
  where "O(f:: 'a \<Rightarrow> 'b) = {h. \<exists>c. \<forall>x. abs (h x) \<le> c * abs (f x)}"

lemma bigo_pos_const:
  "(\<exists>c::'a::linordered_idom. \<forall>x. abs (h x) \<le> c * abs (f x)) \<longleftrightarrow>
    (\<exists>c. 0 < c \<and> (\<forall>x. abs (h x) \<le> c * abs (f x)))"
  apply auto
  apply (case_tac "c = 0")
  apply simp
  apply (rule_tac x = "1" in exI)
  apply simp
  apply (rule_tac x = "abs c" in exI)
  apply auto
  apply (subgoal_tac "c * abs (f x) \<le> abs c * abs (f x)")
  apply (erule_tac x = x in allE)
  apply force
  apply (rule mult_right_mono)
  apply (rule abs_ge_self)
  apply (rule abs_ge_zero)
  done

lemma bigo_alt_def: "O(f) = {h. \<exists>c. 0 < c \<and> (\<forall>x. abs (h x) \<le> c * abs (f x))}"
  by (auto simp add: bigo_def bigo_pos_const)

lemma bigo_elt_subset [intro]: "f \<in> O(g) \<Longrightarrow> O(f) \<le> O(g)"
  apply (auto simp add: bigo_alt_def)
  apply (rule_tac x = "ca * c" in exI)
  apply (rule conjI)
  apply simp
  apply (rule allI)
  apply (drule_tac x = "xa" in spec)+
  apply (subgoal_tac "ca * abs (f xa) \<le> ca * (c * abs (g xa))")
  apply (erule order_trans)
  apply (simp add: ac_simps)
  apply (rule mult_left_mono, assumption)
  apply (rule order_less_imp_le, assumption)
  done

lemma bigo_refl [intro]: "f \<in> O(f)"
  apply(auto simp add: bigo_def)
  apply(rule_tac x = 1 in exI)
  apply simp
  done

lemma bigo_zero: "0 \<in> O(g)"
  apply (auto simp add: bigo_def func_zero)
  apply (rule_tac x = 0 in exI)
  apply auto
  done

lemma bigo_zero2: "O(\<lambda>x. 0) = {\<lambda>x. 0}"
  by (auto simp add: bigo_def)

lemma bigo_plus_self_subset [intro]: "O(f) + O(f) \<subseteq> O(f)"
  apply (auto simp add: bigo_alt_def set_plus_def)
  apply (rule_tac x = "c + ca" in exI)
  apply auto
  apply (simp add: ring_distribs func_plus)
  apply (rule order_trans)
  apply (rule abs_triangle_ineq)
  apply (rule add_mono)
  apply force
  apply force
  done

lemma bigo_plus_idemp [simp]: "O(f) + O(f) = O(f)"
  apply (rule equalityI)
  apply (rule bigo_plus_self_subset)
  apply (rule set_zero_plus2)
  apply (rule bigo_zero)
  done

lemma bigo_plus_subset [intro]: "O(f + g) \<subseteq> O(f) + O(g)"
  apply (rule subsetI)
  apply (auto simp add: bigo_def bigo_pos_const func_plus set_plus_def)
  apply (subst bigo_pos_const [symmetric])+
  apply (rule_tac x = "\<lambda>n. if abs (g n) \<le> (abs (f n)) then x n else 0" in exI)
  apply (rule conjI)
  apply (rule_tac x = "c + c" in exI)
  apply (clarsimp)
  apply (subgoal_tac "c * abs (f xa + g xa) \<le> (c + c) * abs (f xa)")
  apply (erule_tac x = xa in allE)
  apply (erule order_trans)
  apply (simp)
  apply (subgoal_tac "c * abs (f xa + g xa) \<le> c * (abs (f xa) + abs (g xa))")
  apply (erule order_trans)
  apply (simp add: ring_distribs)
  apply (rule mult_left_mono)
  apply (simp add: abs_triangle_ineq)
  apply (simp add: order_less_le)
  apply (rule_tac x = "\<lambda>n. if (abs (f n)) < abs (g n) then x n else 0" in exI)
  apply (rule conjI)
  apply (rule_tac x = "c + c" in exI)
  apply auto
  apply (subgoal_tac "c * abs (f xa + g xa) \<le> (c + c) * abs (g xa)")
  apply (erule_tac x = xa in allE)
  apply (erule order_trans)
  apply simp
  apply (subgoal_tac "c * abs (f xa + g xa) \<le> c * (abs (f xa) + abs (g xa))")
  apply (erule order_trans)
  apply (simp add: ring_distribs)
  apply (rule mult_left_mono)
  apply (rule abs_triangle_ineq)
  apply (simp add: order_less_le)
  done

lemma bigo_plus_subset2 [intro]: "A \<subseteq> O(f) \<Longrightarrow> B \<subseteq> O(f) \<Longrightarrow> A + B \<subseteq> O(f)"
  apply (subgoal_tac "A + B \<subseteq> O(f) + O(f)")
  apply (erule order_trans)
  apply simp
  apply (auto del: subsetI simp del: bigo_plus_idemp)
  done

lemma bigo_plus_eq: "\<forall>x. 0 \<le> f x \<Longrightarrow> \<forall>x. 0 \<le> g x \<Longrightarrow> O(f + g) = O(f) + O(g)"
  apply (rule equalityI)
  apply (rule bigo_plus_subset)
  apply (simp add: bigo_alt_def set_plus_def func_plus)
  apply clarify
  apply (rule_tac x = "max c ca" in exI)
  apply (rule conjI)
  apply (subgoal_tac "c \<le> max c ca")
  apply (erule order_less_le_trans)
  apply assumption
  apply (rule max.cobounded1)
  apply clarify
  apply (drule_tac x = "xa" in spec)+
  apply (subgoal_tac "0 \<le> f xa + g xa")
  apply (simp add: ring_distribs)
  apply (subgoal_tac "abs (a xa + b xa) \<le> abs (a xa) + abs (b xa)")
  apply (subgoal_tac "abs (a xa) + abs (b xa) \<le> max c ca * f xa + max c ca * g xa")
  apply force
  apply (rule add_mono)
  apply (subgoal_tac "c * f xa \<le> max c ca * f xa")
  apply force
  apply (rule mult_right_mono)
  apply (rule max.cobounded1)
  apply assumption
  apply (subgoal_tac "ca * g xa \<le> max c ca * g xa")
  apply force
  apply (rule mult_right_mono)
  apply (rule max.cobounded2)
  apply assumption
  apply (rule abs_triangle_ineq)
  apply (rule add_nonneg_nonneg)
  apply assumption+
  done

lemma bigo_bounded_alt: "\<forall>x. 0 \<le> f x \<Longrightarrow> \<forall>x. f x \<le> c * g x \<Longrightarrow> f \<in> O(g)"
  apply (auto simp add: bigo_def)
  apply (rule_tac x = "abs c" in exI)
  apply auto
  apply (drule_tac x = x in spec)+
  apply (simp add: abs_mult [symmetric])
  done

lemma bigo_bounded: "\<forall>x. 0 \<le> f x \<Longrightarrow> \<forall>x. f x \<le> g x \<Longrightarrow> f \<in> O(g)"
  apply (erule bigo_bounded_alt [of f 1 g])
  apply simp
  done

lemma bigo_bounded2: "\<forall>x. lb x \<le> f x \<Longrightarrow> \<forall>x. f x \<le> lb x + g x \<Longrightarrow> f \<in> lb +o O(g)"
  apply (rule set_minus_imp_plus)
  apply (rule bigo_bounded)
  apply (auto simp add: fun_Compl_def func_plus)
  apply (drule_tac x = x in spec)+
  apply force
  apply (drule_tac x = x in spec)+
  apply force
  done

lemma bigo_abs: "(\<lambda>x. abs (f x)) =o O(f)"
  apply (unfold bigo_def)
  apply auto
  apply (rule_tac x = 1 in exI)
  apply auto
  done

lemma bigo_abs2: "f =o O(\<lambda>x. abs (f x))"
  apply (unfold bigo_def)
  apply auto
  apply (rule_tac x = 1 in exI)
  apply auto
  done

lemma bigo_abs3: "O(f) = O(\<lambda>x. abs (f x))"
  apply (rule equalityI)
  apply (rule bigo_elt_subset)
  apply (rule bigo_abs2)
  apply (rule bigo_elt_subset)
  apply (rule bigo_abs)
  done

lemma bigo_abs4: "f =o g +o O(h) \<Longrightarrow> (\<lambda>x. abs (f x)) =o (\<lambda>x. abs (g x)) +o O(h)"
  apply (drule set_plus_imp_minus)
  apply (rule set_minus_imp_plus)
  apply (subst fun_diff_def)
proof -
  assume a: "f - g \<in> O(h)"
  have "(\<lambda>x. abs (f x) - abs (g x)) =o O(\<lambda>x. abs (abs (f x) - abs (g x)))"
    by (rule bigo_abs2)
  also have "\<dots> \<subseteq> O(\<lambda>x. abs (f x - g x))"
    apply (rule bigo_elt_subset)
    apply (rule bigo_bounded)
    apply force
    apply (rule allI)
    apply (rule abs_triangle_ineq3)
    done
  also have "\<dots> \<subseteq> O(f - g)"
    apply (rule bigo_elt_subset)
    apply (subst fun_diff_def)
    apply (rule bigo_abs)
    done
  also from a have "\<dots> \<subseteq> O(h)"
    by (rule bigo_elt_subset)
  finally show "(\<lambda>x. abs (f x) - abs (g x)) \<in> O(h)".
qed

lemma bigo_abs5: "f =o O(g) \<Longrightarrow> (\<lambda>x. abs (f x)) =o O(g)"
  by (unfold bigo_def, auto)

lemma bigo_elt_subset2 [intro]: "f \<in> g +o O(h) \<Longrightarrow> O(f) \<subseteq> O(g) + O(h)"
proof -
  assume "f \<in> g +o O(h)"
  also have "\<dots> \<subseteq> O(g) + O(h)"
    by (auto del: subsetI)
  also have "\<dots> = O(\<lambda>x. abs (g x)) + O(\<lambda>x. abs (h x))"
    apply (subst bigo_abs3 [symmetric])+
    apply (rule refl)
    done
  also have "\<dots> = O((\<lambda>x. abs (g x)) + (\<lambda>x. abs (h x)))"
    by (rule bigo_plus_eq [symmetric]) auto
  finally have "f \<in> \<dots>" .
  then have "O(f) \<subseteq> \<dots>"
    by (elim bigo_elt_subset)
  also have "\<dots> = O(\<lambda>x. abs (g x)) + O(\<lambda>x. abs (h x))"
    by (rule bigo_plus_eq, auto)
  finally show ?thesis
    by (simp add: bigo_abs3 [symmetric])
qed

lemma bigo_mult [intro]: "O(f)*O(g) \<subseteq> O(f * g)"
  apply (rule subsetI)
  apply (subst bigo_def)
  apply (auto simp add: bigo_alt_def set_times_def func_times)
  apply (rule_tac x = "c * ca" in exI)
  apply (rule allI)
  apply (erule_tac x = x in allE)+
  apply (subgoal_tac "c * ca * abs (f x * g x) = (c * abs (f x)) * (ca * abs (g x))")
  apply (erule ssubst)
  apply (subst abs_mult)
  apply (rule mult_mono)
  apply assumption+
  apply auto
  apply (simp add: ac_simps abs_mult)
  done

lemma bigo_mult2 [intro]: "f *o O(g) \<subseteq> O(f * g)"
  apply (auto simp add: bigo_def elt_set_times_def func_times abs_mult)
  apply (rule_tac x = c in exI)
  apply auto
  apply (drule_tac x = x in spec)
  apply (subgoal_tac "abs (f x) * abs (b x) \<le> abs (f x) * (c * abs (g x))")
  apply (force simp add: ac_simps)
  apply (rule mult_left_mono, assumption)
  apply (rule abs_ge_zero)
  done

lemma bigo_mult3: "f \<in> O(h) \<Longrightarrow> g \<in> O(j) \<Longrightarrow> f * g \<in> O(h * j)"
  apply (rule subsetD)
  apply (rule bigo_mult)
  apply (erule set_times_intro, assumption)
  done

lemma bigo_mult4 [intro]: "f \<in> k +o O(h) \<Longrightarrow> g * f \<in> (g * k) +o O(g * h)"
  apply (drule set_plus_imp_minus)
  apply (rule set_minus_imp_plus)
  apply (drule bigo_mult3 [where g = g and j = g])
  apply (auto simp add: algebra_simps)
  done

lemma bigo_mult5:
  fixes f :: "'a \<Rightarrow> 'b::linordered_field"
  assumes "\<forall>x. f x \<noteq> 0"
  shows "O(f * g) \<subseteq> f *o O(g)"
proof
  fix h
  assume "h \<in> O(f * g)"
  then have "(\<lambda>x. 1 / (f x)) * h \<in> (\<lambda>x. 1 / f x) *o O(f * g)"
    by auto
  also have "\<dots> \<subseteq> O((\<lambda>x. 1 / f x) * (f * g))"
    by (rule bigo_mult2)
  also have "(\<lambda>x. 1 / f x) * (f * g) = g"
    apply (simp add: func_times)
    apply (rule ext)
    apply (simp add: assms nonzero_divide_eq_eq ac_simps)
    done
  finally have "(\<lambda>x. (1::'b) / f x) * h \<in> O(g)" .
  then have "f * ((\<lambda>x. (1::'b) / f x) * h) \<in> f *o O(g)"
    by auto
  also have "f * ((\<lambda>x. (1::'b) / f x) * h) = h"
    apply (simp add: func_times)
    apply (rule ext)
    apply (simp add: assms nonzero_divide_eq_eq ac_simps)
    done
  finally show "h \<in> f *o O(g)" .
qed

lemma bigo_mult6:
  fixes f :: "'a \<Rightarrow> 'b::linordered_field"
  shows "\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = f *o O(g)"
  apply (rule equalityI)
  apply (erule bigo_mult5)
  apply (rule bigo_mult2)
  done

lemma bigo_mult7:
  fixes f :: "'a \<Rightarrow> 'b::linordered_field"
  shows "\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<subseteq> O(f) * O(g)"
  apply (subst bigo_mult6)
  apply assumption
  apply (rule set_times_mono3)
  apply (rule bigo_refl)
  done

lemma bigo_mult8:
  fixes f :: "'a \<Rightarrow> 'b::linordered_field"
  shows "\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f) * O(g)"
  apply (rule equalityI)
  apply (erule bigo_mult7)
  apply (rule bigo_mult)
  done

lemma bigo_minus [intro]: "f \<in> O(g) \<Longrightarrow> - f \<in> O(g)"
  by (auto simp add: bigo_def fun_Compl_def)

lemma bigo_minus2: "f \<in> g +o O(h) \<Longrightarrow> - f \<in> -g +o O(h)"
  apply (rule set_minus_imp_plus)
  apply (drule set_plus_imp_minus)
  apply (drule bigo_minus)
  apply simp
  done

lemma bigo_minus3: "O(- f) = O(f)"
  by (auto simp add: bigo_def fun_Compl_def)

lemma bigo_plus_absorb_lemma1: "f \<in> O(g) \<Longrightarrow> f +o O(g) \<subseteq> O(g)"
proof -
  assume a: "f \<in> O(g)"
  show "f +o O(g) \<subseteq> O(g)"
  proof -
    have "f \<in> O(f)" by auto
    then have "f +o O(g) \<subseteq> O(f) + O(g)"
      by (auto del: subsetI)
    also have "\<dots> \<subseteq> O(g) + O(g)"
    proof -
      from a have "O(f) \<subseteq> O(g)" by (auto del: subsetI)
      then show ?thesis by (auto del: subsetI)
    qed
    also have "\<dots> \<subseteq> O(g)" by simp
    finally show ?thesis .
  qed
qed

lemma bigo_plus_absorb_lemma2: "f \<in> O(g) \<Longrightarrow> O(g) \<subseteq> f +o O(g)"
proof -
  assume a: "f \<in> O(g)"
  show "O(g) \<subseteq> f +o O(g)"
  proof -
    from a have "- f \<in> O(g)"
      by auto
    then have "- f +o O(g) \<subseteq> O(g)"
      by (elim bigo_plus_absorb_lemma1)
    then have "f +o (- f +o O(g)) \<subseteq> f +o O(g)"
      by auto
    also have "f +o (- f +o O(g)) = O(g)"
      by (simp add: set_plus_rearranges)
    finally show ?thesis .
  qed
qed

lemma bigo_plus_absorb [simp]: "f \<in> O(g) \<Longrightarrow> f +o O(g) = O(g)"
  apply (rule equalityI)
  apply (erule bigo_plus_absorb_lemma1)
  apply (erule bigo_plus_absorb_lemma2)
  done

lemma bigo_plus_absorb2 [intro]: "f \<in> O(g) \<Longrightarrow> A \<subseteq> O(g) \<Longrightarrow> f +o A \<subseteq> O(g)"
  apply (subgoal_tac "f +o A \<subseteq> f +o O(g)")
  apply force+
  done

lemma bigo_add_commute_imp: "f \<in> g +o O(h) \<Longrightarrow> g \<in> f +o O(h)"
  apply (subst set_minus_plus [symmetric])
  apply (subgoal_tac "g - f = - (f - g)")
  apply (erule ssubst)
  apply (rule bigo_minus)
  apply (subst set_minus_plus)
  apply assumption
  apply (simp add: ac_simps)
  done

lemma bigo_add_commute: "f \<in> g +o O(h) \<longleftrightarrow> g \<in> f +o O(h)"
  apply (rule iffI)
  apply (erule bigo_add_commute_imp)+
  done

lemma bigo_const1: "(\<lambda>x. c) \<in> O(\<lambda>x. 1)"
  by (auto simp add: bigo_def ac_simps)

lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<subseteq> O(\<lambda>x. 1)"
  apply (rule bigo_elt_subset)
  apply (rule bigo_const1)
  done

lemma bigo_const3:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. 1) \<in> O(\<lambda>x. c)"
  apply (simp add: bigo_def)
  apply (rule_tac x = "abs (inverse c)" in exI)
  apply (simp add: abs_mult [symmetric])
  done

lemma bigo_const4:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> O(\<lambda>x. 1) \<subseteq> O(\<lambda>x. c)"
  apply (rule bigo_elt_subset)
  apply (rule bigo_const3)
  apply assumption
  done

lemma bigo_const [simp]:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> O(\<lambda>x. c) = O(\<lambda>x. 1)"
  apply (rule equalityI)
  apply (rule bigo_const2)
  apply (rule bigo_const4)
  apply assumption
  done

lemma bigo_const_mult1: "(\<lambda>x. c * f x) \<in> O(f)"
  apply (simp add: bigo_def)
  apply (rule_tac x = "abs c" in exI)
  apply (auto simp add: abs_mult [symmetric])
  done

lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<subseteq> O(f)"
  apply (rule bigo_elt_subset)
  apply (rule bigo_const_mult1)
  done

lemma bigo_const_mult3:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> f \<in> O(\<lambda>x. c * f x)"
  apply (simp add: bigo_def)
  apply (rule_tac x = "abs (inverse c)" in exI)
  apply (simp add: abs_mult [symmetric] mult.assoc [symmetric])
  done

lemma bigo_const_mult4:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> O(f) \<subseteq> O(\<lambda>x. c * f x)"
  apply (rule bigo_elt_subset)
  apply (rule bigo_const_mult3)
  apply assumption
  done

lemma bigo_const_mult [simp]:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> O(\<lambda>x. c * f x) = O(f)"
  apply (rule equalityI)
  apply (rule bigo_const_mult2)
  apply (erule bigo_const_mult4)
  done

lemma bigo_const_mult5 [simp]:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. c) *o O(f) = O(f)"
  apply (auto del: subsetI)
  apply (rule order_trans)
  apply (rule bigo_mult2)
  apply (simp add: func_times)
  apply (auto intro!: simp add: bigo_def elt_set_times_def func_times)
  apply (rule_tac x = "\<lambda>y. inverse c * x y" in exI)
  apply (simp add: mult.assoc [symmetric] abs_mult)
  apply (rule_tac x = "abs (inverse c) * ca" in exI)
  apply (rule allI)
  apply (subst mult.assoc)
  apply (rule mult_left_mono)
  apply (erule spec)
  apply force
  done

lemma bigo_const_mult6 [intro]: "(\<lambda>x. c) *o O(f) \<subseteq> O(f)"
  apply (auto intro!: simp add: bigo_def elt_set_times_def func_times)
  apply (rule_tac x = "ca * abs c" in exI)
  apply (rule allI)
  apply (subgoal_tac "ca * abs c * abs (f x) = abs c * (ca * abs (f x))")
  apply (erule ssubst)
  apply (subst abs_mult)
  apply (rule mult_left_mono)
  apply (erule spec)
  apply simp
  apply(simp add: ac_simps)
  done

lemma bigo_const_mult7 [intro]: "f =o O(g) \<Longrightarrow> (\<lambda>x. c * f x) =o O(g)"
proof -
  assume "f =o O(g)"
  then have "(\<lambda>x. c) * f =o (\<lambda>x. c) *o O(g)"
    by auto
  also have "(\<lambda>x. c) * f = (\<lambda>x. c * f x)"
    by (simp add: func_times)
  also have "(\<lambda>x. c) *o O(g) \<subseteq> O(g)"
    by (auto del: subsetI)
  finally show ?thesis .
qed

lemma bigo_compose1: "f =o O(g) \<Longrightarrow> (\<lambda>x. f (k x)) =o O(\<lambda>x. g (k x))"
  unfolding bigo_def by auto

lemma bigo_compose2: "f =o g +o O(h) \<Longrightarrow>
    (\<lambda>x. f (k x)) =o (\<lambda>x. g (k x)) +o O(\<lambda>x. h(k x))"
  apply (simp only: set_minus_plus [symmetric] fun_Compl_def func_plus)
  apply (drule bigo_compose1)
  apply (simp add: fun_diff_def)
  done

subsection {* Setsum *}

lemma bigo_setsum_main: "\<forall>x. \<forall>y \<in> A x. 0 \<le> h x y \<Longrightarrow>
    \<exists>c. \<forall>x. \<forall>y \<in> A x. abs (f x y) \<le> c * (h x y) \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. f x y) =o O(\<lambda>x. \<Sum>y \<in> A x. h x y)"
  apply (auto simp add: bigo_def)
  apply (rule_tac x = "abs c" in exI)
  apply (subst abs_of_nonneg) back back
  apply (rule setsum_nonneg)
  apply force
  apply (subst setsum_right_distrib)
  apply (rule allI)
  apply (rule order_trans)
  apply (rule setsum_abs)
  apply (rule setsum_mono)
  apply (rule order_trans)
  apply (drule spec)+
  apply (drule bspec)+
  apply assumption+
  apply (drule bspec)
  apply assumption+
  apply (rule mult_right_mono)
  apply (rule abs_ge_self)
  apply force
  done

lemma bigo_setsum1: "\<forall>x y. 0 \<le> h x y \<Longrightarrow>
    \<exists>c. \<forall>x y. abs (f x y) \<le> c * h x y \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. f x y) =o O(\<lambda>x. \<Sum>y \<in> A x. h x y)"
  apply (rule bigo_setsum_main)
  apply force
  apply clarsimp
  apply (rule_tac x = c in exI)
  apply force
  done

lemma bigo_setsum2: "\<forall>y. 0 \<le> h y \<Longrightarrow>
    \<exists>c. \<forall>y. abs (f y) \<le> c * (h y) \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. f y) =o O(\<lambda>x. \<Sum>y \<in> A x. h y)"
  by (rule bigo_setsum1) auto

lemma bigo_setsum3: "f =o O(h) \<Longrightarrow>
    (\<lambda>x. \<Sum>y \<in> A x. l x y * f (k x y)) =o O(\<lambda>x. \<Sum>y \<in> A x. abs (l x y * h (k x y)))"
  apply (rule bigo_setsum1)
  apply (rule allI)+
  apply (rule abs_ge_zero)
  apply (unfold bigo_def)
  apply auto
  apply (rule_tac x = c in exI)
  apply (rule allI)+
  apply (subst abs_mult)+
  apply (subst mult.left_commute)
  apply (rule mult_left_mono)
  apply (erule spec)
  apply (rule abs_ge_zero)
  done

lemma bigo_setsum4: "f =o g +o O(h) \<Longrightarrow>
    (\<lambda>x. \<Sum>y \<in> A x. l x y * f (k x y)) =o
      (\<lambda>x. \<Sum>y \<in> A x. l x y * g (k x y)) +o
        O(\<lambda>x. \<Sum>y \<in> A x. abs (l x y * h (k x y)))"
  apply (rule set_minus_imp_plus)
  apply (subst fun_diff_def)
  apply (subst setsum_subtractf [symmetric])
  apply (subst right_diff_distrib [symmetric])
  apply (rule bigo_setsum3)
  apply (subst fun_diff_def [symmetric])
  apply (erule set_plus_imp_minus)
  done

lemma bigo_setsum5: "f =o O(h) \<Longrightarrow> \<forall>x y. 0 \<le> l x y \<Longrightarrow>
    \<forall>x. 0 \<le> h x \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. l x y * f (k x y)) =o
        O(\<lambda>x. \<Sum>y \<in> A x. l x y * h (k x y))"
  apply (subgoal_tac "(\<lambda>x. \<Sum>y \<in> A x. l x y * h (k x y)) =
      (\<lambda>x. \<Sum>y \<in> A x. abs (l x y * h (k x y)))")
  apply (erule ssubst)
  apply (erule bigo_setsum3)
  apply (rule ext)
  apply (rule setsum.cong)
  apply (rule refl)
  apply (subst abs_of_nonneg)
  apply auto
  done

lemma bigo_setsum6: "f =o g +o O(h) \<Longrightarrow> \<forall>x y. 0 \<le> l x y \<Longrightarrow>
    \<forall>x. 0 \<le> h x \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. l x y * f (k x y)) =o
        (\<lambda>x. \<Sum>y \<in> A x. l x y * g (k x y)) +o
          O(\<lambda>x. \<Sum>y \<in> A x. l x y * h (k x y))"
  apply (rule set_minus_imp_plus)
  apply (subst fun_diff_def)
  apply (subst setsum_subtractf [symmetric])
  apply (subst right_diff_distrib [symmetric])
  apply (rule bigo_setsum5)
  apply (subst fun_diff_def [symmetric])
  apply (drule set_plus_imp_minus)
  apply auto
  done

subsection {* Misc useful stuff *}

lemma bigo_useful_intro: "A \<subseteq> O(f) \<Longrightarrow> B \<subseteq> O(f) \<Longrightarrow> A + B \<subseteq> O(f)"
  apply (subst bigo_plus_idemp [symmetric])
  apply (rule set_plus_mono2)
  apply assumption+
  done

lemma bigo_useful_add: "f =o O(h) \<Longrightarrow> g =o O(h) \<Longrightarrow> f + g =o O(h)"
  apply (subst bigo_plus_idemp [symmetric])
  apply (rule set_plus_intro)
  apply assumption+
  done

lemma bigo_useful_const_mult:
  fixes c :: "'a::linordered_field"
  shows "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
  apply (rule subsetD)
  apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) \<subseteq> O(h)")
  apply assumption
  apply (rule bigo_const_mult6)
  apply (subgoal_tac "f = (\<lambda>x. 1 / c) * ((\<lambda>x. c) * f)")
  apply (erule ssubst)
  apply (erule set_times_intro2)
  apply (simp add: func_times)
  done

lemma bigo_fix: "(\<lambda>x::nat. f (x + 1)) =o O(\<lambda>x. h (x + 1)) \<Longrightarrow> f 0 = 0 \<Longrightarrow> f =o O(h)"
  apply (simp add: bigo_alt_def)
  apply auto
  apply (rule_tac x = c in exI)
  apply auto
  apply (case_tac "x = 0")
  apply simp
  apply (subgoal_tac "x = Suc (x - 1)")
  apply (erule ssubst) back
  apply (erule spec)
  apply simp
  done

lemma bigo_fix2:
    "(\<lambda>x. f ((x::nat) + 1)) =o (\<lambda>x. g(x + 1)) +o O(\<lambda>x. h(x + 1)) \<Longrightarrow>
       f 0 = g 0 \<Longrightarrow> f =o g +o O(h)"
  apply (rule set_minus_imp_plus)
  apply (rule bigo_fix)
  apply (subst fun_diff_def)
  apply (subst fun_diff_def [symmetric])
  apply (rule set_plus_imp_minus)
  apply simp
  apply (simp add: fun_diff_def)
  done

subsection {* Less than or equal to *}

definition lesso :: "('a \<Rightarrow> 'b::linordered_idom) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"  (infixl "<o" 70)
  where "f <o g = (\<lambda>x. max (f x - g x) 0)"

lemma bigo_lesseq1: "f =o O(h) \<Longrightarrow> \<forall>x. abs (g x) \<le> abs (f x) \<Longrightarrow> g =o O(h)"
  apply (unfold bigo_def)
  apply clarsimp
  apply (rule_tac x = c in exI)
  apply (rule allI)
  apply (rule order_trans)
  apply (erule spec)+
  done

lemma bigo_lesseq2: "f =o O(h) \<Longrightarrow> \<forall>x. abs (g x) \<le> f x \<Longrightarrow> g =o O(h)"
  apply (erule bigo_lesseq1)
  apply (rule allI)
  apply (drule_tac x = x in spec)
  apply (rule order_trans)
  apply assumption
  apply (rule abs_ge_self)
  done

lemma bigo_lesseq3: "f =o O(h) \<Longrightarrow> \<forall>x. 0 \<le> g x \<Longrightarrow> \<forall>x. g x \<le> f x \<Longrightarrow> g =o O(h)"
  apply (erule bigo_lesseq2)
  apply (rule allI)
  apply (subst abs_of_nonneg)
  apply (erule spec)+
  done

lemma bigo_lesseq4: "f =o O(h) \<Longrightarrow>
    \<forall>x. 0 \<le> g x \<Longrightarrow> \<forall>x. g x \<le> abs (f x) \<Longrightarrow> g =o O(h)"
  apply (erule bigo_lesseq1)
  apply (rule allI)
  apply (subst abs_of_nonneg)
  apply (erule spec)+
  done

lemma bigo_lesso1: "\<forall>x. f x \<le> g x \<Longrightarrow> f <o g =o O(h)"
  apply (unfold lesso_def)
  apply (subgoal_tac "(\<lambda>x. max (f x - g x) 0) = 0")
  apply (erule ssubst)
  apply (rule bigo_zero)
  apply (unfold func_zero)
  apply (rule ext)
  apply (simp split: split_max)
  done

lemma bigo_lesso2: "f =o g +o O(h) \<Longrightarrow>
    \<forall>x. 0 \<le> k x \<Longrightarrow> \<forall>x. k x \<le> f x \<Longrightarrow> k <o g =o O(h)"
  apply (unfold lesso_def)
  apply (rule bigo_lesseq4)
  apply (erule set_plus_imp_minus)
  apply (rule allI)
  apply (rule max.cobounded2)
  apply (rule allI)
  apply (subst fun_diff_def)
  apply (case_tac "0 \<le> k x - g x")
  apply simp
  apply (subst abs_of_nonneg)
  apply (drule_tac x = x in spec) back
  apply (simp add: algebra_simps)
  apply (subst diff_conv_add_uminus)+
  apply (rule add_right_mono)
  apply (erule spec)
  apply (rule order_trans)
  prefer 2
  apply (rule abs_ge_zero)
  apply (simp add: algebra_simps)
  done

lemma bigo_lesso3: "f =o g +o O(h) \<Longrightarrow>
    \<forall>x. 0 \<le> k x \<Longrightarrow> \<forall>x. g x \<le> k x \<Longrightarrow> f <o k =o O(h)"
  apply (unfold lesso_def)
  apply (rule bigo_lesseq4)
  apply (erule set_plus_imp_minus)
  apply (rule allI)
  apply (rule max.cobounded2)
  apply (rule allI)
  apply (subst fun_diff_def)
  apply (case_tac "0 \<le> f x - k x")
  apply simp
  apply (subst abs_of_nonneg)
  apply (drule_tac x = x in spec) back
  apply (simp add: algebra_simps)
  apply (subst diff_conv_add_uminus)+
  apply (rule add_left_mono)
  apply (rule le_imp_neg_le)
  apply (erule spec)
  apply (rule order_trans)
  prefer 2
  apply (rule abs_ge_zero)
  apply (simp add: algebra_simps)
  done

lemma bigo_lesso4:
  fixes k :: "'a \<Rightarrow> 'b::linordered_field"
  shows "f <o g =o O(k) \<Longrightarrow> g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
  apply (unfold lesso_def)
  apply (drule set_plus_imp_minus)
  apply (drule bigo_abs5) back
  apply (simp add: fun_diff_def)
  apply (drule bigo_useful_add)
  apply assumption
  apply (erule bigo_lesseq2) back
  apply (rule allI)
  apply (auto simp add: func_plus fun_diff_def algebra_simps split: split_max abs_split)
  done

lemma bigo_lesso5: "f <o g =o O(h) \<Longrightarrow> \<exists>C. \<forall>x. f x \<le> g x + C * abs (h x)"
  apply (simp only: lesso_def bigo_alt_def)
  apply clarsimp
  apply (rule_tac x = c in exI)
  apply (rule allI)
  apply (drule_tac x = x in spec)
  apply (subgoal_tac "abs (max (f x - g x) 0) = max (f x - g x) 0")
  apply (clarsimp simp add: algebra_simps)
  apply (rule abs_of_nonneg)
  apply (rule max.cobounded2)
  done

lemma lesso_add: "f <o g =o O(h) \<Longrightarrow> k <o l =o O(h) \<Longrightarrow> (f + k) <o (g + l) =o O(h)"
  apply (unfold lesso_def)
  apply (rule bigo_lesseq3)
  apply (erule bigo_useful_add)
  apply assumption
  apply (force split: split_max)
  apply (auto split: split_max simp add: func_plus)
  done

lemma bigo_LIMSEQ1: "f =o O(g) \<Longrightarrow> g ----> 0 \<Longrightarrow> f ----> (0::real)"
  apply (simp add: LIMSEQ_iff bigo_alt_def)
  apply clarify
  apply (drule_tac x = "r / c" in spec)
  apply (drule mp)
  apply simp
  apply clarify
  apply (rule_tac x = no in exI)
  apply (rule allI)
  apply (drule_tac x = n in spec)+
  apply (rule impI)
  apply (drule mp)
  apply assumption
  apply (rule order_le_less_trans)
  apply assumption
  apply (rule order_less_le_trans)
  apply (subgoal_tac "c * abs (g n) < c * (r / c)")
  apply assumption
  apply (erule mult_strict_left_mono)
  apply assumption
  apply simp
  done

lemma bigo_LIMSEQ2: "f =o g +o O(h) \<Longrightarrow> h ----> 0 \<Longrightarrow> f ----> a \<Longrightarrow> g ----> (a::real)"
  apply (drule set_plus_imp_minus)
  apply (drule bigo_LIMSEQ1)
  apply assumption
  apply (simp only: fun_diff_def)
  apply (erule LIMSEQ_diff_approach_zero2)
  apply assumption
  done

end


(* 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.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_list_nat_count_nub
imports "../../Test_Base"
begin

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

datatype Nat = Z | S "Nat"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S z) y = S (plus z y)"

fun filter :: "('a => bool) => 'a list => 'a list" where
"filter q (nil2) = nil2"
| "filter q (cons2 y xs) =
     (if q y then cons2 y (filter q xs) else filter q xs)"

(*fun did not finish the proof*)
function nubBy :: "('a => ('a => bool)) => 'a list => 'a list" where
"nubBy x (nil2) = nil2"
| "nubBy x (cons2 z xs) =
     cons2 z (nubBy x (filter (% (y2 :: 'a) => (~ ((x z) y2))) xs))"
by pat_completeness auto

(*fun did not finish the proof*)
function elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"
by pat_completeness auto

fun count :: "'a => 'a list => Nat" where
"count x (nil2) = Z"
| "count x (cons2 z ys) =
     (if (x = z) then plus (S Z) (count x ys) else count x ys)"

theorem property0 :
  "((elem x xs) ==>
      ((count x (nubBy (% (y :: 'a) => % (z :: 'a) => (y = z)) xs)) =
         (S Z)))"
  oops

end


theory Smap_unfold_stream
  imports Main "$HIPSTER_HOME/IsaHipster"
begin

setup Tactic_Data.set_coinduct_sledgehammer
codatatype (sset: 'a) Stream =
  SCons (shd: 'a) (stl: "'a Stream")

primcorec smap :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a Stream \<Rightarrow> 'b Stream" where
  "smap f xs = SCons (f (shd xs)) (smap f (stl xs))"

primcorec unfold_stream :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b Stream" where
  "unfold_stream g1 g2 a = SCons (g1 a) (unfold_stream g1 g2 (g2 a))"

datatype 'a Lst =
  Emp
  | Cons "'a" "'a Lst"

fun obsStream :: "int \<Rightarrow> 'a Stream \<Rightarrow> 'a Lst" where
"obsStream n s = (if (n \<le> 0) then Emp else Cons (shd s) (obsStream (n - 1) (stl s)))"
fun shead :: "'a Stream \<Rightarrow> 'a" where
  "shead xs = shd xs"
fun stail :: "'a Stream \<Rightarrow> 'a Stream" where
  "stail xs = stl xs"
(*hipster_obs Stream Lst obsStream smap unfold_stream shead stail
*)
lemma lemma_a [thy_expl]: "smap y (unfold_stream z z x2) = unfold_stream y z (z x2)"
  apply (coinduction  arbitrary: x2 y z rule: Smap_unfold_stream.Stream.coinduct_strong)
  apply simp
  by auto
theorem smap_unfold_stream:
  "smap f (unfold_stream shead stail b) = unfold_stream (f \<circ> shead) stail b"
by hipster_coinduct_sledgehammer

end


(* 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.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_subst_SubstFreeYes
  imports "../../Test_Base"
begin

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

datatype Expr = Var "int" | Lam "int" "Expr" | App "Expr" "Expr"

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

fun newmaximum :: "int => int list => int" where
  "newmaximum y (nil2) = y"
| "newmaximum y (cons2 z2 ys) =
     (if y <= z2 then newmaximum z2 ys else newmaximum y ys)"

fun new :: "int list => int" where
  "new y = (newmaximum 0 y) + 1"

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter p (nil2) = nil2"
| "filter p (cons2 z xs) =
     (if p z then cons2 z (filter p xs) else filter p xs)"

fun free :: "Expr => int list" where
  "free (Var z) = cons2 z (nil2)"
| "free (Lam z2 b) = filter (% (x2 :: int) => (z2 ~= x2)) (free b)"
| "free (App a2 b2) = x (free a2) (free b2)"

fun elem :: "'a => 'a list => bool" where
  "elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

(*fun did not finish the proof*)
function subst :: "int => Expr => Expr => Expr" where
  "subst y z (Var y2) = (if (y = y2) then z else Var y2)"
| "subst y z (Lam y3 a) =
     (let z22 :: int = new (x (free z) (free a))
     in (if (y = y3) then Lam y3 a else
           (if elem y3 (free z) then
              subst y z (Lam z22 (subst y3 (Var z22) a))
              else
              Lam y3 (subst y z a))))"
| "subst y z (App a2 b2) = App (subst y z a2) (subst y z b2)"
  by pat_completeness auto

theorem property0 :
  "((elem y (free a)) ==>
      ((elem
          z (x (filter (% (z2 :: int) => (z2 ~= y)) (free a)) (free e))) =
         (elem z (free (subst y e a)))))"
  oops

end


(* Author: Tobias Nipkow *)

section "Interval Analysis"

theory Abs_Int2_ivl
imports Abs_Int2 "HOL-IMP.Abs_Int_Tests"
begin

datatype ivl = I "int option" "int option"

definition "\<gamma>_ivl i = (case i of
  I (Some l) (Some h) \<Rightarrow> {l..h} |
  I (Some l) None \<Rightarrow> {l..} |
  I None (Some h) \<Rightarrow> {..h} |
  I None None \<Rightarrow> UNIV)"

abbreviation I_Some_Some :: "int \<Rightarrow> int \<Rightarrow> ivl"  ("{_\<dots>_}") where
"{lo\<dots>hi} == I (Some lo) (Some hi)"
abbreviation I_Some_None :: "int \<Rightarrow> ivl"  ("{_\<dots>}") where
"{lo\<dots>} == I (Some lo) None"
abbreviation I_None_Some :: "int \<Rightarrow> ivl"  ("{\<dots>_}") where
"{\<dots>hi} == I None (Some hi)"
abbreviation I_None_None :: "ivl"  ("{\<dots>}") where
"{\<dots>} == I None None"

definition "num_ivl n = {n\<dots>n}"

fun in_ivl :: "int \<Rightarrow> ivl \<Rightarrow> bool" where
"in_ivl k (I (Some l) (Some h)) \<longleftrightarrow> l \<le> k \<and> k \<le> h" |
"in_ivl k (I (Some l) None) \<longleftrightarrow> l \<le> k" |
"in_ivl k (I None (Some h)) \<longleftrightarrow> k \<le> h" |
"in_ivl k (I None None) \<longleftrightarrow> True"

instantiation option :: (plus)plus
begin

fun plus_option where
"Some x + Some y = Some(x+y)" |
"_ + _ = None"

instance ..

end

definition empty where "empty = {1\<dots>0}"

fun is_empty where
"is_empty {l\<dots>h} = (h<l)" |
"is_empty _ = False"

lemma [simp]: "is_empty i \<Longrightarrow> \<gamma>_ivl i = {}"
by(auto simp add: \<gamma>_ivl_def split: ivl.split option.split)

definition "plus_ivl i1 i2 = (if is_empty i1 | is_empty i2 then empty else
  case (i1,i2) of (I l1 h1, I l2 h2) \<Rightarrow> I (l1+l2) (h1+h2))"

instantiation ivl :: SL_top
begin

definition le_option :: "bool \<Rightarrow> int option \<Rightarrow> int option \<Rightarrow> bool" where
"le_option pos x y =
 (case x of (Some i) \<Rightarrow> (case y of Some j \<Rightarrow> i\<le>j | None \<Rightarrow> pos)
  | None \<Rightarrow> (case y of Some j \<Rightarrow> \<not>pos | None \<Rightarrow> True))"

fun le_aux where
"le_aux (I l1 h1) (I l2 h2) = (le_option False l2 l1 & le_option True h1 h2)"

definition le_ivl where
"i1 \<sqsubseteq> i2 =
 (if is_empty i1 then True else
  if is_empty i2 then False else le_aux i1 i2)"

definition min_option :: "bool \<Rightarrow> int option \<Rightarrow> int option \<Rightarrow> int option" where
"min_option pos o1 o2 = (if le_option pos o1 o2 then o1 else o2)"

definition max_option :: "bool \<Rightarrow> int option \<Rightarrow> int option \<Rightarrow> int option" where
"max_option pos o1 o2 = (if le_option pos o1 o2 then o2 else o1)"

definition "i1 \<squnion> i2 =
 (if is_empty i1 then i2 else if is_empty i2 then i1
  else case (i1,i2) of (I l1 h1, I l2 h2) \<Rightarrow>
          I (min_option False l1 l2) (max_option True h1 h2))"

definition "\<top> = {\<dots>}"

instance
proof (standard, goal_cases)
  case (1 x) thus ?case
    by(cases x, simp add: le_ivl_def le_option_def split: option.split)
next
  case (2 x y z) thus ?case
    by(cases x, cases y, cases z, auto simp: le_ivl_def le_option_def split: option.splits if_splits)
next
  case (3 x y) thus ?case
    by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits)
next
  case (4 x y) thus ?case
    by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits)
next
  case (5 x y z) thus ?case
    by(cases x, cases y, cases z, auto simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits if_splits)
next
  case (6 x) thus ?case
    by(cases x, simp add: Top_ivl_def le_ivl_def le_option_def split: option.split)
qed

end

instantiation ivl :: L_top_bot
begin

definition "i1 \<sqinter> i2 = (if is_empty i1 \<or> is_empty i2 then empty else
  case (i1,i2) of (I l1 h1, I l2 h2) \<Rightarrow>
    I (max_option False l1 l2) (min_option True h1 h2))"

definition "\<bottom> = empty"

instance
proof (standard, goal_cases)
  case 1 thus ?case
    by (simp add:meet_ivl_def empty_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits)
next
  case 2 thus ?case
    by (simp add: empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits)
next
  case (3 x y z) thus ?case
    by (cases x, cases y, cases z, auto simp add: le_ivl_def meet_ivl_def empty_def le_option_def max_option_def min_option_def split: option.splits if_splits)
next
  case (4 x) show ?case by(cases x, simp add: bot_ivl_def empty_def le_ivl_def)
qed

end

instantiation option :: (minus)minus
begin

fun minus_option where
"Some x - Some y = Some(x-y)" |
"_ - _ = None"

instance ..

end

definition "minus_ivl i1 i2 = (if is_empty i1 | is_empty i2 then empty else
  case (i1,i2) of (I l1 h1, I l2 h2) \<Rightarrow> I (l1-h2) (h1-l2))"

lemma gamma_minus_ivl:
  "n1 : \<gamma>_ivl i1 \<Longrightarrow> n2 : \<gamma>_ivl i2 \<Longrightarrow> n1-n2 : \<gamma>_ivl(minus_ivl i1 i2)"
by(auto simp add: minus_ivl_def \<gamma>_ivl_def split: ivl.splits option.splits)

definition "filter_plus_ivl i i1 i2 = (\<^cancel>\<open>if is_empty i then empty else\<close>
  i1 \<sqinter> minus_ivl i i2, i2 \<sqinter> minus_ivl i i1)"

fun filter_less_ivl :: "bool \<Rightarrow> ivl \<Rightarrow> ivl \<Rightarrow> ivl * ivl" where
"filter_less_ivl res (I l1 h1) (I l2 h2) =
  (if is_empty(I l1 h1) \<or> is_empty(I l2 h2) then (empty, empty) else
   if res
   then (I l1 (min_option True h1 (h2 - Some 1)),
         I (max_option False (l1 + Some 1) l2) h2)
   else (I (max_option False l1 l2) h1, I l2 (min_option True h1 h2)))"

global_interpretation Val_abs
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
proof (standard, goal_cases)
  case 1 thus ?case
    by(auto simp: \<gamma>_ivl_def le_ivl_def le_option_def split: ivl.split option.split if_splits)
next
  case 2 show ?case by(simp add: \<gamma>_ivl_def Top_ivl_def)
next
  case 3 thus ?case by(simp add: \<gamma>_ivl_def num_ivl_def)
next
  case 4 thus ?case
    by(auto simp add: \<gamma>_ivl_def plus_ivl_def split: ivl.split option.splits)
qed

global_interpretation Val_abs1_gamma
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
defines aval_ivl = aval'
proof (standard, goal_cases)
  case 1 thus ?case
    by(auto simp add: \<gamma>_ivl_def meet_ivl_def empty_def min_option_def max_option_def split: ivl.split option.split)
next
  case 2 show ?case by(auto simp add: bot_ivl_def \<gamma>_ivl_def empty_def)
qed

lemma mono_minus_ivl:
  "i1 \<sqsubseteq> i1' \<Longrightarrow> i2 \<sqsubseteq> i2' \<Longrightarrow> minus_ivl i1 i2 \<sqsubseteq> minus_ivl i1' i2'"
apply(auto simp add: minus_ivl_def empty_def le_ivl_def le_option_def split: ivl.splits)
  apply(simp split: option.splits)
 apply(simp split: option.splits)
apply(simp split: option.splits)
done

global_interpretation Val_abs1
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
and test_num' = in_ivl
and filter_plus' = filter_plus_ivl and filter_less' = filter_less_ivl
proof (standard, goal_cases)
  case 1 thus ?case
    by (simp add: \<gamma>_ivl_def split: ivl.split option.split)
next
  case 2 thus ?case
    by(auto simp add: filter_plus_ivl_def)
      (metis gamma_minus_ivl add_diff_cancel add.commute)+
next
  case (3 _ _ a1 a2) thus ?case
    by(cases a1, cases a2,
      auto simp: \<gamma>_ivl_def min_option_def max_option_def le_option_def split: if_splits option.splits)
qed

global_interpretation Abs_Int1
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
and test_num' = in_ivl
and filter_plus' = filter_plus_ivl and filter_less' = filter_less_ivl
defines afilter_ivl = afilter
and bfilter_ivl = bfilter
and step_ivl = step'
and AI_ivl = AI
and aval_ivl' = aval''
..

text\<open>Monotonicity:\<close>

global_interpretation Abs_Int1_mono
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
and test_num' = in_ivl
and filter_plus' = filter_plus_ivl and filter_less' = filter_less_ivl
proof (standard, goal_cases)
  case 1 thus ?case
    by(auto simp: plus_ivl_def le_ivl_def le_option_def empty_def split: if_splits ivl.splits option.splits)
next
  case 2 thus ?case
    by(auto simp: filter_plus_ivl_def le_prod_def mono_meet mono_minus_ivl)
next
  case (3 a1 b1 a2 b2) thus ?case
    apply(cases a1, cases b1, cases a2, cases b2, auto simp: le_prod_def)
    by(auto simp add: empty_def le_ivl_def le_option_def min_option_def max_option_def split: option.splits)
qed

subsection "Tests"

value "show_acom_opt (AI_ivl test1_ivl)"

text\<open>Better than \<open>AI_const\<close>:\<close>
value "show_acom_opt (AI_ivl test3_const)"
value "show_acom_opt (AI_ivl test4_const)"
value "show_acom_opt (AI_ivl test6_const)"

value "show_acom_opt (AI_ivl test2_ivl)"
value "show_acom (((step_ivl \<top>)^^0) (\<bottom>\<^sub>c test2_ivl))"
value "show_acom (((step_ivl \<top>)^^1) (\<bottom>\<^sub>c test2_ivl))"
value "show_acom (((step_ivl \<top>)^^2) (\<bottom>\<^sub>c test2_ivl))"

text\<open>Fixed point reached in 2 steps. Not so if the start value of x is known:\<close>

value "show_acom_opt (AI_ivl test3_ivl)"
value "show_acom (((step_ivl \<top>)^^0) (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (((step_ivl \<top>)^^1) (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (((step_ivl \<top>)^^2) (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (((step_ivl \<top>)^^3) (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (((step_ivl \<top>)^^4) (\<bottom>\<^sub>c test3_ivl))"

text\<open>Takes as many iterations as the actual execution. Would diverge if
loop did not terminate. Worse still, as the following example shows: even if
the actual execution terminates, the analysis may not. The value of y keeps
decreasing as the analysis is iterated, no matter how long:\<close>

value "show_acom (((step_ivl \<top>)^^50) (\<bottom>\<^sub>c test4_ivl))"

text\<open>Relationships between variables are NOT captured:\<close>
value "show_acom_opt (AI_ivl test5_ivl)"

text\<open>Again, the analysis would not terminate:\<close>
value "show_acom (((step_ivl \<top>)^^50) (\<bottom>\<^sub>c test6_ivl))"

end


theory NQueens
imports VDMToolkit "HOL-Library.Multiset_Order"
begin

abbreviation
  BOARD_SIZE :: \<open>VDMNat1\<close>
  where
  "BOARD_SIZE \<equiv> 8"

abbreviation
  MAX_QUEENS :: \<open>VDMNat1\<close>
  where
  "MAX_QUEENS \<equiv> BOARD_SIZE"

type_synonym Queens = "VDMNat1"

definition
  inv_Queens :: \<open>VDMNat1 \<Rightarrow> \<bool>\<close>
  where
  \<open>inv_Queens q \<equiv> inv_VDMNat1 q \<and> q \<le> MAX_QUEENS + 1\<close>

lemmas inv_Queens_defs = inv_Queens_def inv_VDMNat1_def

type_synonym Pos = "VDMNat"

definition
  inv_Pos :: \<open>VDMNat \<Rightarrow> \<bool>\<close>
  where
  "inv_Pos p \<equiv> inv_VDMNat p \<and> p < BOARD_SIZE"

lemmas inv_Pos_defs = inv_Pos_def inv_VDMNat_def

type_synonym Coord = "Pos \<times> Pos"

definition
  inv_Coord :: "Coord \<Rightarrow> \<bool>"
  where
  "inv_Coord p \<equiv> let (r,c) = p in inv_Pos r \<and> inv_Pos c"

lemmas inv_Coord_defs = inv_Coord_def inv_Pos_defs

type_synonym Board = "Coord VDMSet"

definition
  inv_Board :: "Board \<Rightarrow> \<bool>"
  where
  "inv_Board b \<equiv> inv_VDMSet' inv_Coord b \<and> vdm_card b \<le> BOARD_SIZE * BOARD_SIZE"

lemmas inv_Board_defs = inv_Board_def inv_VDMSet'_defs inv_Coord_defs vdm_card_defs

definition
  pre_allowed :: \<open>VDMNat \<Rightarrow> VDMNat \<Rightarrow> Board \<Rightarrow> \<bool>\<close>
  where
  \<open>pre_allowed r c b \<equiv> inv_VDMNat r \<and> inv_VDMNat c \<and> inv_Board b\<close>

lemmas pre_allowed_defs = inv_VDMNat_def inv_Board_defs
(*
definition
  post_allowed :: \<open>VDMNat \<Rightarrow> VDMNat \<Rightarrow> Board \<Rightarrow> \<bool> \<Rightarrow> \<bool>\<close>
  where
 \<open>post_allowed r c b RESULT \<equiv>
    pre_allowed r c b \<longrightarrow> RESULT \<longrightarrow> post_vdm_abs (r - r') (vdm_abs (r - r')) \<close>
*)

definition
  allowed :: \<open>Pos \<Rightarrow> Pos \<Rightarrow> Board \<Rightarrow> \<bool>\<close>
  where
  \<open>allowed r c board \<equiv>
      (r, c) \<in> board \<and>
      \<not> (\<exists> b \<in> board . let (r',c') = b in r = r' \<or> c = c' \<or> vdm_abs (r - r') = vdm_abs (c - c'))
  \<close>

lemmas allowed_defs = allowed_def vdm_abs_def

definition
  pre_possible :: \<open>Board \<Rightarrow> \<bool>\<close>
  where
  \<open>pre_possible board \<equiv> inv_Board board \<close>
  (*\<and> (\<forall> (r, c) \<in> board . pre_allowed r c board) *)

definition
  post_possible :: \<open>Board \<Rightarrow> Board \<Rightarrow> \<bool>\<close>
  where
  \<open>post_possible board RESULT \<equiv> inv_Board RESULT \<and> RESULT \<inter> board = {}\<close>

definition
  possible :: \<open>Board \<Rightarrow> Board\<close>
  where
  \<open>possible board \<equiv> { (r, c) | r c . r \<in> {(0::VDMNat)..BOARD_SIZE-1} \<and> c \<in> {0..BOARD_SIZE-1} \<and> (allowed r c board) }\<close>

definition
  pre_solve :: \<open>Board \<Rightarrow> Queens \<Rightarrow> \<bool>\<close>
  where
\<open>pre_solve board Q \<equiv> inv_Board board \<and> inv_Queens Q \<and> pre_possible board \<and> post_possible board (possible board) \<and>
    (Q < MAX_QUEENS \<and> possible board \<noteq> {} \<longrightarrow> vdm_card board < BOARD_SIZE * BOARD_SIZE)\<close>

text \<open>Interestingly, what would happen if we had a mutually recursive dependency between
both functions' preconditions?\<close>
definition
  pre_trys :: \<open>Coord VDMSet \<Rightarrow> Board \<Rightarrow> VDMNat1 \<Rightarrow> \<bool>\<close>
  where
\<open>pre_trys possible' board Q \<equiv>
    inv_VDMSet' inv_Coord possible' \<and> inv_Board board \<and> inv_Queens Q \<and>
    Q \<le> MAX_QUEENS \<and> (\<forall> p \<in> possible' . pre_solve (board \<union> {p}) (Q+1))\<close>

lemmas pre_solve_defs = pre_solve_def inv_Board_defs inv_Queens_defs
lemmas pre_trys_defs  = pre_trys_def inv_VDMSet'_def inv_Coord_defs inv_Board_defs inv_VDMNat1_def
declare pre_solve_defs []
declare pre_trys_defs []
declare allowed_defs []
function (domintros)
  solve :: \<open>Board \<Rightarrow> Queens \<Rightarrow> Board option\<close> and
  trys  :: \<open>Coord VDMSet \<Rightarrow> Board \<Rightarrow> Queens \<Rightarrow> Board option\<close>
  where
  \<open>solve board Q =
      (if pre_solve board Q then
          (if Q = MAX_QUEENS + 1 then
            Some board
          else
            (let possible' = possible board in
                (trys possible' board Q))
          )
       else
          undefined)
  \<close>
| \<open>trys possible' board Q =
    (if pre_trys possible' board Q then
       if possible' = {} then
          None
       else
          let p = (\<some> x . x \<in> possible') in
              let solution = solve (board \<union> {p}) (Q+1) in
                if solution = None then
                  (trys (possible' - {p}) board Q)
                else
                  solution
     else
      undefined
    )
  \<close>
  by (pat_completeness, auto)

text \<open>We have to create a termination term for each of the recursive calls, where Isabelle sum-type
is used to represent each of the calls. The term is a relation from the sum-types, where the domain
represents the recursive calls, whereas the range represents the original call.

So, for the first recursive call, we have the call site for \<^term>\<open>trys\<close>, hence the \<^term>\<open>Inr\<close> projection
on the domain, whereas the entry site for \<^term>\<open>solve\<close> is on the right hand side with \<^term>\<open>Inl\<close>.
The other two sets represents the other corresponding two call sites. Each call site also have
their corresponding filtering conditions for the call to work. \<close>
definition
  solve_try_wf ::"(((Board \<times> Queens) + ((Coord VDMSet) \<times> Board \<times> Queens)) \<times> ((Board \<times> Queens) + ((Coord VDMSet) \<times> Board \<times> Queens))) set" where
  "solve_try_wf \<equiv>
  { (Inr(possible', board, q),Inl(board, q)) | possible' board q .
      pre_solve board q \<and>
      pre_trys possible' board q \<and>
      q \<noteq> MAX_QUEENS + 1 \<and>
      possible' = (possible board)
  }
\<union> { (Inl(board', q'), Inr(possible', board, q)) | possible' board q board' q' .
     pre_trys possible' board q \<and>
     possible' \<noteq> {} \<and>
     pre_solve board' q' \<and>
     board' = (board \<union> {(\<some> x . x \<in> possible')}) \<and>
     q' = q+1
  }
\<union> { (Inr(possibleCall, board, q), Inr(possibleEntry, board, q)) | possibleEntry p board' q' possibleCall board q .
     pre_trys possibleEntry board q \<and>
     pre_trys possibleCall board q \<and>
     possibleEntry \<noteq> {} \<and>
     p = (\<some> x . x \<in> possibleEntry) \<and>
     pre_solve board' q' \<and>
     possibleCall = possibleEntry - {p} \<and>
     board' = board \<union> {p} \<and>
     q' = q+1 \<and>
     solve board' q' = None
  }"

definition
  solve_try_measure :: \<open>(Board \<times> Queens) + ((Coord VDMSet) \<times> Board \<times> Queens) \<Rightarrow> \<nat>\<close>
  where
  \<open>solve_try_measure x \<equiv>
      case x of
        Inl (board, Q) \<Rightarrow> if Q = MAX_QUEENS+1 then 0 else nat((BOARD_SIZE * BOARD_SIZE) - (vdm_card board))
      | Inr (possible', board, Q) \<Rightarrow> if possible' = {} then 0 else 0
  \<close>

lemma wf_solve_try: "wf (solve_try_wf)"
  unfolding solve_try_wf_def
  apply simp
  thm wf_measure wf_subset wf_measure [THEN wf_subset]
    apply (intro wf_measure [THEN wf_subset] subsetI, simp, safe, simp_all)
  apply (simp add: measure_def inv_image_def less_than_def less_eq)
  sorry

(*
lemma l_possible_finite: "finite { (r, c) | r c . 0 \<le> r \<and> r \<le> 7 \<and> 0 \<le> c \<and> c \<le> 7 }"
  find_theorems name:fin name:induc
  find_theorems "_ \<Longrightarrow> finite _"
  apply (cut_tac subset_eq_atLeast0_atMost_finite)
  thm finite_subset
   apply (rule Finite_Set.finite_subset_induct) sorry
lemma l_try_possible: \<open>pre_solve board q \<and> q \<noteq> MAX_QUEENS + 1 \<Longrightarrow>
  possible' = { (r, c) | r c . r \<in> {(0::VDMNat)..BOARD_SIZE-1} \<and> c \<in> {0..BOARD_SIZE-1} \<and> (allowed r c board) } \<Longrightarrow>
  pre_trys possible' board q\<close>
  unfolding vdm_card_def pre_trys_defs pre_solve_defs
  apply (simp, safe)
   apply (rule finite_subset[of _ \<open>{ (r, c) | r c . r \<in> {(0::VDMNat)..BOARD_SIZE-1} \<and> c \<in> {0..BOARD_SIZE-1} }\<close>])
    apply (rule subsetI, simp add: case_prod_beta)
  apply (insert l_possible_finite)
  apply (simp)+
  done
  sorry
*)

lemma l_try_solve: \<open>
  pre_trys possible' board q \<Longrightarrow>
  possible' \<noteq> {}  \<Longrightarrow>
  pre_solve ({SOME x. x \<in> possible'} \<union> board) (q + 1)\<close>
  unfolding pre_solve_def pre_trys_def
  apply (simp add: case_prod_beta)
  apply (elim conjE, intro conjI)
    apply (erule_tac x=\<open>SOME x. x \<in> possible'\<close> in ballE)
  apply simp
  using some_in_eq apply blast
    apply fastforce
  using some_in_eq apply blast+
  done

lemma l_try_try: \<open>pre_trys possible' board q \<Longrightarrow>
  pre_trys (possible' - {SOME x. x \<in> possible'}) board q\<close>
  unfolding pre_trys_def
  apply (simp add: l_inv_VDMSet_remove_x)
  done

lemma l_pre_solve_pre_try: \<open>pre_solve board Q \<Longrightarrow>
       Q \<noteq> 9 \<Longrightarrow> pre_trys (possible board) board Q\<close>
  unfolding pre_trys_def pre_solve_def pre_possible_def
  apply (simp, elim conjE, intro conjI, simp_all)
  unfolding post_possible_def inv_Board_def
    apply simp
  unfolding inv_Queens_def apply simp sorry

lemma l_pre_try_pre_solve: \<open>
  pre_trys possible' board Q \<Longrightarrow> possible' \<noteq> {} \<Longrightarrow>
  pre_solve ({SOME x. x \<in> possible'} \<union> board) (Q + 1)\<close>
  unfolding pre_trys_def
  by (simp add: some_in_eq)

termination
  apply (relation \<open>solve_try_wf\<close>)
     apply (simp add: wf_solve_try)
    apply (simp add: solve_try_wf_def l_pre_solve_pre_try)
   apply (simp add: solve_try_wf_def)
  using l_pre_try_pre_solve apply auto[1]
   apply (simp add: solve_try_wf_def)
  oops

termination
  apply (relation \<open>measure solve_try_measure\<close>)
     apply simp_all
  oops

definition
  run :: \<open>Board option\<close>
  where
  \<open>run \<equiv> solve {} 1\<close>
end