(* Author: Tobias Nipkow *)

subsection "Collecting Semantics of Commands"

theory Collecting
imports Complete_Lattice Big_Step ACom
begin

subsubsection "The generic Step function"

notation
  sup (infixl "\<squnion>" 65) and
  inf (infixl "\<sqinter>" 70) and
  bot ("\<bottom>") and
  top ("\<top>")

context
  fixes f :: "vname \<Rightarrow> aexp \<Rightarrow> 'a \<Rightarrow> 'a::sup"
  fixes g :: "bexp \<Rightarrow> 'a \<Rightarrow> 'a"
begin
fun Step :: "'a \<Rightarrow> 'a acom \<Rightarrow> 'a acom" where
"Step S (SKIP {Q}) = (SKIP {S})" |
"Step S (x ::= e {Q}) =
  x ::= e {f x e S}" |
"Step S (C1;; C2) = Step S C1;; Step (post C1) C2" |
"Step S (IF b THEN {P1} C1 ELSE {P2} C2 {Q}) =
  IF b THEN {g b S} Step P1 C1 ELSE {g (Not b) S} Step P2 C2
  {post C1 \<squnion> post C2}" |
"Step S ({I} WHILE b DO {P} C {Q}) =
  {S \<squnion> post C} WHILE b DO {g b I} Step P C {g (Not b) I}"
end

lemma strip_Step[simp]: "strip(Step f g S C) = strip C"
by(induct C arbitrary: S) auto

subsubsection "Annotated commands as a complete lattice"

instantiation acom :: (order) order
begin

definition less_eq_acom :: "('a::order)acom \<Rightarrow> 'a acom \<Rightarrow> bool" where
"C1 \<le> C2 \<longleftrightarrow> strip C1 = strip C2 \<and> (\<forall>p<size(annos C1). anno C1 p \<le> anno C2 p)"

definition less_acom :: "'a acom \<Rightarrow> 'a acom \<Rightarrow> bool" where
"less_acom x y = (x \<le> y \<and> \<not> y \<le> x)"

instance
proof (standard, goal_cases)
  case 1 show ?case by(simp add: less_acom_def)
next
  case 2 thus ?case by(auto simp: less_eq_acom_def)
next
  case 3 thus ?case by(fastforce simp: less_eq_acom_def size_annos)
next
  case 4 thus ?case
    by(fastforce simp: le_antisym less_eq_acom_def size_annos
         eq_acom_iff_strip_anno)
qed

end

lemma less_eq_acom_annos:
  "C1 \<le> C2 \<longleftrightarrow> strip C1 = strip C2 \<and> list_all2 (\<le>) (annos C1) (annos C2)"
by(auto simp add: less_eq_acom_def anno_def list_all2_conv_all_nth size_annos_same2)

lemma SKIP_le[simp]: "SKIP {S} \<le> c \<longleftrightarrow> (\<exists>S'. c = SKIP {S'} \<and> S \<le> S')"
by (cases c) (auto simp:less_eq_acom_def anno_def)

lemma Assign_le[simp]: "x ::= e {S} \<le> c \<longleftrightarrow> (\<exists>S'. c = x ::= e {S'} \<and> S \<le> S')"
by (cases c) (auto simp:less_eq_acom_def anno_def)

lemma Seq_le[simp]: "C1;;C2 \<le> C \<longleftrightarrow> (\<exists>C1' C2'. C = C1';;C2' \<and> C1 \<le> C1' \<and> C2 \<le> C2')"
apply (cases C)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma If_le[simp]: "IF b THEN {p1} C1 ELSE {p2} C2 {S} \<le> C \<longleftrightarrow>
  (\<exists>p1' p2' C1' C2' S'. C = IF b THEN {p1'} C1' ELSE {p2'} C2' {S'} \<and>
     p1 \<le> p1' \<and> p2 \<le> p2' \<and> C1 \<le> C1' \<and> C2 \<le> C2' \<and> S \<le> S')"
apply (cases C)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma While_le[simp]: "{I} WHILE b DO {p} C {P} \<le> W \<longleftrightarrow>
  (\<exists>I' p' C' P'. W = {I'} WHILE b DO {p'} C' {P'} \<and> C \<le> C' \<and> p \<le> p' \<and> I \<le> I' \<and> P \<le> P')"
apply (cases W)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma mono_post: "C \<le> C' \<Longrightarrow> post C \<le> post C'"
using annos_ne[of C']
by(auto simp: post_def less_eq_acom_def last_conv_nth[OF annos_ne] anno_def
     dest: size_annos_same)

definition Inf_acom :: "com \<Rightarrow> 'a::complete_lattice acom set \<Rightarrow> 'a acom" where
"Inf_acom c M = annotate (\<lambda>p. INF C\<in>M. anno C p) c"

global_interpretation
  Complete_Lattice "{C. strip C = c}" "Inf_acom c" for c
proof (standard, goal_cases)
  case 1 thus ?case
    by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_lower)
next
  case 2 thus ?case
    by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_greatest)
next
  case 3 thus ?case by(auto simp: Inf_acom_def)
qed

subsubsection "Collecting semantics"

definition "step = Step (\<lambda>x e S. {s(x := aval e s) |s. s \<in> S}) (\<lambda>b S. {s:S. bval b s})"

definition CS :: "com \<Rightarrow> state set acom" where
"CS c = lfp c (step UNIV)"

lemma mono2_Step: fixes C1 C2 :: "'a::semilattice_sup acom"
  assumes "!!x e S1 S2. S1 \<le> S2 \<Longrightarrow> f x e S1 \<le> f x e S2"
          "!!b S1 S2. S1 \<le> S2 \<Longrightarrow> g b S1 \<le> g b S2"
  shows "C1 \<le> C2 \<Longrightarrow> S1 \<le> S2 \<Longrightarrow> Step f g S1 C1 \<le> Step f g S2 C2"
proof(induction S1 C1 arbitrary: C2 S2 rule: Step.induct)
  case 1 thus ?case by(auto)
next
  case 2 thus ?case by (auto simp: assms(1))
next
  case 3 thus ?case by(auto simp: mono_post)
next
  case 4 thus ?case
    by(auto simp: subset_iff assms(2))
      (metis mono_post le_supI1 le_supI2)+
next
  case 5 thus ?case
    by(auto simp: subset_iff assms(2))
      (metis mono_post le_supI1 le_supI2)+
qed

lemma mono2_step: "C1 \<le> C2 \<Longrightarrow> S1 \<subseteq> S2 \<Longrightarrow> step S1 C1 \<le> step S2 C2"
unfolding step_def by(rule mono2_Step) auto

lemma mono_step: "mono (step S)"
by(blast intro: monoI mono2_step)

lemma strip_step: "strip(step S C) = strip C"
by (induction C arbitrary: S) (auto simp: step_def)

lemma lfp_cs_unfold: "lfp c (step S) = step S (lfp c (step S))"
apply(rule lfp_unfold[OF _  mono_step])
apply(simp add: strip_step)
done

lemma CS_unfold: "CS c = step UNIV (CS c)"
by (metis CS_def lfp_cs_unfold)

lemma strip_CS[simp]: "strip(CS c) = c"
by(simp add: CS_def index_lfp[simplified])

subsubsection "Relation to big-step semantics"

lemma asize_nz: "asize(c::com) \<noteq> 0"
by (metis length_0_conv length_annos_annotate annos_ne)

lemma post_Inf_acom:
  "\<forall>C\<in>M. strip C = c \<Longrightarrow> post (Inf_acom c M) = \<Inter>(post ` M)"
apply(subgoal_tac "\<forall>C\<in>M. size(annos C) = asize c")
 apply(simp add: post_anno_asize Inf_acom_def asize_nz neq0_conv[symmetric])
apply(simp add: size_annos)
done

lemma post_lfp: "post(lfp c f) = (\<Inter>{post C|C. strip C = c \<and> f C \<le> C})"
by(auto simp add: lfp_def post_Inf_acom)

lemma big_step_post_step:
  "\<lbrakk> (c, s) \<Rightarrow> t;  strip C = c;  s \<in> S;  step S C \<le> C \<rbrakk> \<Longrightarrow> t \<in> post C"
proof(induction arbitrary: C S rule: big_step_induct)
  case Skip thus ?case by(auto simp: strip_eq_SKIP step_def post_def)
next
  case Assign thus ?case
    by(fastforce simp: strip_eq_Assign step_def post_def)
next
  case Seq thus ?case
    by(fastforce simp: strip_eq_Seq step_def post_def last_append annos_ne)
next
  case IfTrue thus ?case apply(auto simp: strip_eq_If step_def post_def)
    by (metis (lifting,full_types) mem_Collect_eq subsetD)
next
  case IfFalse thus ?case apply(auto simp: strip_eq_If step_def post_def)
    by (metis (lifting,full_types) mem_Collect_eq subsetD)
next
  case (WhileTrue b s1 c' s2 s3)
  from WhileTrue.prems(1) obtain I P C' Q where "C = {I} WHILE b DO {P} C' {Q}" "strip C' = c'"
    by(auto simp: strip_eq_While)
  from WhileTrue.prems(3) \<open>C = _\<close>
  have "step P C' \<le> C'"  "{s \<in> I. bval b s} \<le> P"  "S \<le> I"  "step (post C') C \<le> C"
    by (auto simp: step_def post_def)
  have "step {s \<in> I. bval b s} C' \<le> C'"
    by (rule order_trans[OF mono2_step[OF order_refl \<open>{s \<in> I. bval b s} \<le> P\<close>] \<open>step P C' \<le> C'\<close>])
  have "s1 \<in> {s\<in>I. bval b s}" using \<open>s1 \<in> S\<close> \<open>S \<subseteq> I\<close> \<open>bval b s1\<close> by auto
  note s2_in_post_C' = WhileTrue.IH(1)[OF \<open>strip C' = c'\<close> this \<open>step {s \<in> I. bval b s} C' \<le> C'\<close>]
  from WhileTrue.IH(2)[OF WhileTrue.prems(1) s2_in_post_C' \<open>step (post C') C \<le> C\<close>]
  show ?case .
next
  case (WhileFalse b s1 c') thus ?case
    by (force simp: strip_eq_While step_def post_def)
qed

lemma big_step_lfp: "\<lbrakk> (c,s) \<Rightarrow> t;  s \<in> S \<rbrakk> \<Longrightarrow> t \<in> post(lfp c (step S))"
by(auto simp add: post_lfp intro: big_step_post_step)

lemma big_step_CS: "(c,s) \<Rightarrow> t \<Longrightarrow> t \<in> post(CS c)"
by(simp add: CS_def big_step_lfp)

end


(*  Title:      HOL/Metis_Examples/Big_O.thy
    Author:     Lawrence C. Paulson, Cambridge University Computer Laboratory
    Author:     Jasmin Blanchette, TU Muenchen

Metis example featuring the Big O notation.
*)

section \<open>Metis Example Featuring the Big O Notation\<close>

theory Big_O
imports
  "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
  "~~/src/HOL/Library/Function_Algebras"
  "~~/src/HOL/Library/Set_Algebras"
begin

subsection \<open>Definitions\<close>

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

lemma bigo_pos_const:
  "(\<exists>c::'a::linordered_idom.
    \<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>)
    \<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>))"
  by (metis (no_types) abs_ge_zero
      algebra_simps mult.comm_neutral
      mult_nonpos_nonneg not_le_imp_less order_trans zero_less_one)

(*** Now various verions with an increasing shrink factor ***)

sledgehammer_params [isar_proofs, compress = 1]

lemma
  "(\<exists>c::'a::linordered_idom.
    \<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>)
    \<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>))"
  apply auto
  apply (case_tac "c = 0", simp)
  apply (rule_tac x = "1" in exI, simp)
  apply (rule_tac x = "\<bar>c\<bar>" in exI, auto)
proof -
  fix c :: 'a and x :: 'b
  assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
  have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 0 \<le> \<bar>x\<^sub>1\<bar>" by (metis abs_ge_zero)
  have F2: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
  have F3: "\<forall>x\<^sub>1 x\<^sub>3. x\<^sub>3 \<le> \<bar>h x\<^sub>1\<bar> \<longrightarrow> x\<^sub>3 \<le> c * \<bar>f x\<^sub>1\<bar>" by (metis A1 order_trans)
  have F4: "\<forall>x\<^sub>2 x\<^sub>3::'a::linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
    by (metis abs_mult)
  have F5: "\<forall>x\<^sub>3 x\<^sub>1::'a::linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1"
    by (metis abs_mult_pos)
  hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = \<bar>1\<bar> * x\<^sub>1" by (metis F2)
  hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F2 abs_one)
  hence "\<forall>x\<^sub>3. 0 \<le> \<bar>h x\<^sub>3\<bar> \<longrightarrow> \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis F3)
  hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis F1)
  hence "\<forall>x\<^sub>3. (0::'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c\<bar> * \<bar>f x\<^sub>3\<bar>" by (metis F5)
  hence "\<forall>x\<^sub>3. (0::'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F4)
  hence "\<forall>x\<^sub>3. c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F1)
  hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1)
  thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis F4)
qed

sledgehammer_params [isar_proofs, compress = 2]

lemma
  "(\<exists>c::'a::linordered_idom.
    \<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>)
    \<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>))"
  apply auto
  apply (case_tac "c = 0", simp)
  apply (rule_tac x = "1" in exI, simp)
  apply (rule_tac x = "\<bar>c\<bar>" in exI, auto)
proof -
  fix c :: 'a and x :: 'b
  assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
  have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
  have F2: "\<forall>x\<^sub>2 x\<^sub>3::'a::linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
    by (metis abs_mult)
  have "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_mult_pos abs_one)
  hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis A1 abs_ge_zero order_trans)
  hence "\<forall>x\<^sub>3. 0 \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F2 abs_mult_pos)
  hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1 abs_ge_zero)
  thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis F2)
qed

sledgehammer_params [isar_proofs, compress = 3]

lemma
  "(\<exists>c::'a::linordered_idom.
    \<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>)
    \<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>))"
  apply auto
  apply (case_tac "c = 0", simp)
  apply (rule_tac x = "1" in exI, simp)
  apply (rule_tac x = "\<bar>c\<bar>" in exI, auto)
proof -
  fix c :: 'a and x :: 'b
  assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
  have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
  have F2: "\<forall>x\<^sub>3 x\<^sub>1::'a::linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1" by (metis abs_mult_pos)
  hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_one)
  hence "\<forall>x\<^sub>3. 0 \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c\<bar> * \<bar>f x\<^sub>3\<bar>" by (metis F2 A1 abs_ge_zero order_trans)
  thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis A1 abs_ge_zero)
qed

sledgehammer_params [isar_proofs, compress = 4]

lemma
  "(\<exists>c::'a::linordered_idom.
    \<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>)
    \<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>))"
  apply auto
  apply (case_tac "c = 0", simp)
  apply (rule_tac x = "1" in exI, simp)
  apply (rule_tac x = "\<bar>c\<bar>" in exI, auto)
proof -
  fix c :: 'a and x :: 'b
  assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
  have "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
  hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>"
    by (metis A1 abs_ge_zero order_trans abs_mult_pos abs_one)
  hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1 abs_ge_zero abs_mult_pos abs_mult)
  thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis abs_mult)
qed

sledgehammer_params [isar_proofs, compress = 1]

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

lemma bigo_elt_subset [intro]: "f : O(g) \<Longrightarrow> O(f) \<le> O(g)"
apply (auto simp add: bigo_alt_def)
apply (rule_tac x = "ca * c" in exI)
apply (metis algebra_simps mult_le_cancel_left_pos order_trans mult_pos_pos)
done

lemma bigo_refl [intro]: "f : O(f)"
unfolding bigo_def mem_Collect_eq
by (metis mult_1 order_refl)

lemma bigo_zero: "0 : O(g)"
apply (auto simp add: bigo_def func_zero)
by (metis mult_zero_left order_refl)

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) <= 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)
by (metis order_trans abs_triangle_ineq add_mono)

lemma bigo_plus_idemp [simp]: "O(f) + O(f) = O(f)"
by (metis bigo_plus_self_subset bigo_zero set_eq_subset set_zero_plus2)

lemma bigo_plus_subset [intro]: "O(f + g) <= 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 \<bar>g n\<bar> <= \<bar>f n\<bar> then x n else 0" in exI)
apply (rule conjI)
 apply (rule_tac x = "c + c" in exI)
 apply clarsimp
 apply (subgoal_tac "c * \<bar>f xa + g xa\<bar> <= (c + c) * \<bar>f xa\<bar>")
  apply (metis mult_2 order_trans)
 apply (subgoal_tac "c * \<bar>f xa + g xa\<bar> <= c * (\<bar>f xa\<bar> + \<bar>g xa\<bar>)")
  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 \<bar>f n\<bar> < \<bar>g n\<bar> then x n else 0" in exI)
apply (rule conjI)
 apply (rule_tac x = "c + c" in exI)
 apply auto
apply (subgoal_tac "c * \<bar>f xa + g xa\<bar> <= (c + c) * \<bar>g xa\<bar>")
 apply (metis order_trans mult_2)
apply (subgoal_tac "c * \<bar>f xa + g xa\<bar> <= c * (\<bar>f xa\<bar> + \<bar>g xa\<bar>)")
 apply (erule order_trans)
 apply (simp add: ring_distribs)
by (metis abs_triangle_ineq mult_le_cancel_left_pos)

lemma bigo_plus_subset2 [intro]: "A <= O(f) \<Longrightarrow> B <= O(f) \<Longrightarrow> A + B <= O(f)"
by (metis bigo_plus_idemp set_plus_mono2)

lemma bigo_plus_eq: "\<forall>x. 0 <= f x \<Longrightarrow> \<forall>x. 0 <= 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
(* sledgehammer *)
apply (rule_tac x = "max c ca" in exI)

apply (rule conjI)
 apply (metis less_max_iff_disj)
apply clarify
apply (drule_tac x = "xa" in spec)+
apply (subgoal_tac "0 <= f xa + g xa")
 apply (simp add: ring_distribs)
 apply (subgoal_tac "\<bar>a xa + b xa\<bar> <= \<bar>a xa\<bar> + \<bar>b xa\<bar>")
  apply (subgoal_tac "\<bar>a xa\<bar> + \<bar>b xa\<bar> <= max c ca * f xa + max c ca * g xa")
   apply (metis order_trans)
  defer 1
  apply (metis abs_triangle_ineq)
 apply (metis add_nonneg_nonneg)
apply (rule add_mono)
 apply (metis max.cobounded2 linorder_linear max.absorb1 mult_right_mono xt1(6))
by (metis max.cobounded2 linorder_not_le mult_le_cancel_right order_trans)

lemma bigo_bounded_alt: "\<forall>x. 0 <= f x \<Longrightarrow> \<forall>x. f x <= c * g x \<Longrightarrow> f : O(g)"
apply (auto simp add: bigo_def)
(* Version 1: one-line proof *)
by (metis abs_le_D1 linorder_class.not_less order_less_le Orderings.xt1(12) abs_mult)

lemma "\<forall>x. 0 <= f x \<Longrightarrow> \<forall>x. f x <= c * g x \<Longrightarrow> f : O(g)"
apply (auto simp add: bigo_def)
(* Version 2: structured proof *)
proof -
  assume "\<forall>x. f x \<le> c * g x"
  thus "\<exists>c. \<forall>x. f x \<le> c * \<bar>g x\<bar>" by (metis abs_mult abs_ge_self order_trans)
qed

lemma bigo_bounded: "\<forall>x. 0 <= f x \<Longrightarrow> \<forall>x. f x <= g x \<Longrightarrow> f : O(g)"
apply (erule bigo_bounded_alt [of f 1 g])
by (metis mult_1)

lemma bigo_bounded2: "\<forall>x. lb x <= f x \<Longrightarrow> \<forall>x. f x <= lb x + g x \<Longrightarrow> f : lb +o O(g)"
apply (rule set_minus_imp_plus)
apply (rule bigo_bounded)
 apply (metis add_le_cancel_left diff_add_cancel diff_self minus_apply
              algebra_simps)
by (metis add_le_cancel_left diff_add_cancel func_plus le_fun_def
          algebra_simps)

lemma bigo_abs: "(\<lambda>x. \<bar>f x\<bar>) =o O(f)"
apply (unfold bigo_def)
apply auto
by (metis mult_1 order_refl)

lemma bigo_abs2: "f =o O(\<lambda>x. \<bar>f x\<bar>)"
apply (unfold bigo_def)
apply auto
by (metis mult_1 order_refl)

lemma bigo_abs3: "O(f) = O(\<lambda>x. \<bar>f x\<bar>)"
proof -
  have F1: "\<forall>v u. u \<in> O(v) \<longrightarrow> O(u) \<subseteq> O(v)" by (metis bigo_elt_subset)
  have F2: "\<forall>u. (\<lambda>R. \<bar>u R\<bar>) \<in> O(u)" by (metis bigo_abs)
  have "\<forall>u. u \<in> O(\<lambda>R. \<bar>u R\<bar>)" by (metis bigo_abs2)
  thus "O(f) = O(\<lambda>x. \<bar>f x\<bar>)" using F1 F2 by auto
qed

lemma bigo_abs4: "f =o g +o O(h) \<Longrightarrow> (\<lambda>x. \<bar>f x\<bar>) =o (\<lambda>x. \<bar>g x\<bar>) +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 : O(h)"
  have "(\<lambda>x. \<bar>f x\<bar> - \<bar>g x\<bar>) =o O(\<lambda>x. \<bar>\<bar>f x\<bar> - \<bar>g x\<bar>\<bar>)"
    by (rule bigo_abs2)
  also have "... <= O(\<lambda>x. \<bar>f x - g x\<bar>)"
    apply (rule bigo_elt_subset)
    apply (rule bigo_bounded)
     apply (metis abs_ge_zero)
    by (metis abs_triangle_ineq3)
  also have "... <= O(f - g)"
    apply (rule bigo_elt_subset)
    apply (subst fun_diff_def)
    apply (rule bigo_abs)
    done
  also have "... <= O(h)"
    using a by (rule bigo_elt_subset)
  finally show "(\<lambda>x. \<bar>f x\<bar> - \<bar>g x\<bar>) : O(h)" .
qed

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

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

lemma bigo_mult [intro]: "O(f) * O(g) <= O(f * g)"
apply (rule subsetI)
apply (subst bigo_def)
apply (auto simp del: abs_mult ac_simps
            simp add: bigo_alt_def set_times_def func_times)
(* sledgehammer *)
apply (rule_tac x = "c * ca" in exI)
apply (rule allI)
apply (erule_tac x = x in allE)+
apply (subgoal_tac "c * ca * \<bar>f x * g x\<bar> = (c * \<bar>f x\<bar>) * (ca * \<bar>g x\<bar>)")
 apply (metis (no_types) abs_ge_zero abs_mult mult_mono')
by (metis mult.assoc mult.left_commute abs_of_pos mult.left_commute abs_mult)

lemma bigo_mult2 [intro]: "f *o O(g) <= O(f * g)"
by (metis bigo_mult bigo_refl set_times_mono3 subset_trans)

lemma bigo_mult3: "f : O(h) \<Longrightarrow> g : O(j) \<Longrightarrow> f * g : O(h * j)"
by (metis bigo_mult set_rev_mp set_times_intro)

lemma bigo_mult4 [intro]:"f : k +o O(h) \<Longrightarrow> g * f : (g * k) +o O(g * h)"
by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)

lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
    O(f * g) <= (f::'a => ('b::linordered_field)) *o O(g)"
proof -
  assume a: "\<forall>x. f x ~= 0"
  show "O(f * g) <= f *o O(g)"
  proof
    fix h
    assume h: "h : O(f * g)"
    then have "(\<lambda>x. 1 / (f x)) * h : (\<lambda>x. 1 / f x) *o O(f * g)"
      by auto
    also have "... <= O((\<lambda>x. 1 / f x) * (f * g))"
      by (rule bigo_mult2)
    also have "(\<lambda>x. 1 / f x) * (f * g) = g"
      by (simp add: fun_eq_iff a)
    finally have "(\<lambda>x. (1::'b) / f x) * h : O(g)".
    then have "f * ((\<lambda>x. (1::'b) / f x) * h) : f *o O(g)"
      by auto
    also have "f * ((\<lambda>x. (1::'b) / f x) * h) = h"
      by (simp add: func_times fun_eq_iff a)
    finally show "h : f *o O(g)".
  qed
qed

lemma bigo_mult6:
"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f::'a \<Rightarrow> ('b::linordered_field)) *o O(g)"
by (metis bigo_mult2 bigo_mult5 order_antisym)

(*proof requires relaxing relevance: 2007-01-25*)
declare bigo_mult6 [simp]

lemma bigo_mult7:
"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f::'a \<Rightarrow> ('b::linordered_field)) * O(g)"
by (metis bigo_refl bigo_mult6 set_times_mono3)

declare bigo_mult6 [simp del]
declare bigo_mult7 [intro!]

lemma bigo_mult8:
"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f::'a \<Rightarrow> ('b::linordered_field)) * O(g)"
by (metis bigo_mult bigo_mult7 order_antisym_conv)

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

lemma bigo_minus2: "f : g +o O(h) \<Longrightarrow> -f : -g +o O(h)"
by (metis (no_types, lifting) bigo_minus diff_minus_eq_add minus_add_distrib
    minus_minus set_minus_imp_plus set_plus_imp_minus)

lemma bigo_minus3: "O(-f) = O(f)"
by (metis bigo_elt_subset bigo_minus bigo_refl equalityI minus_minus)

lemma bigo_plus_absorb_lemma1: "f : O(g) \<Longrightarrow> f +o O(g) \<le> O(g)"
by (metis bigo_plus_idemp set_plus_mono3)

lemma bigo_plus_absorb_lemma2: "f : O(g) \<Longrightarrow> O(g) \<le> f +o O(g)"
by (metis (no_types) bigo_minus bigo_plus_absorb_lemma1 right_minus
          set_plus_mono set_plus_rearrange2 set_zero_plus subsetD subset_refl
          subset_trans)

lemma bigo_plus_absorb [simp]: "f : O(g) \<Longrightarrow> f +o O(g) = O(g)"
by (metis bigo_plus_absorb_lemma1 bigo_plus_absorb_lemma2 order_eq_iff)

lemma bigo_plus_absorb2 [intro]: "f : O(g) \<Longrightarrow> A <= O(g) \<Longrightarrow> f +o A \<le> O(g)"
by (metis bigo_plus_absorb set_plus_mono)

lemma bigo_add_commute_imp: "f : g +o O(h) \<Longrightarrow> g : f +o O(h)"
by (metis bigo_minus minus_diff_eq set_plus_imp_minus set_minus_plus)

lemma bigo_add_commute: "(f : g +o O(h)) = (g : f +o O(h))"
by (metis bigo_add_commute_imp)

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

lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
by (metis bigo_const1 bigo_elt_subset)

lemma bigo_const3: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
apply (simp add: bigo_def)
by (metis abs_eq_0 left_inverse order_refl)

lemma bigo_const4: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
by (metis bigo_elt_subset bigo_const3)

lemma bigo_const [simp]: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
    O(\<lambda>x. c) = O(\<lambda>x. 1)"
by (metis bigo_const2 bigo_const4 equalityI)

lemma bigo_const_mult1: "(\<lambda>x. c * f x) : O(f)"
apply (simp add: bigo_def abs_mult)
by (metis le_less)

lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
by (rule bigo_elt_subset, rule bigo_const_mult1)

lemma bigo_const_mult3: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
apply (simp add: bigo_def)
by (metis (no_types) abs_mult mult.assoc mult_1 order_refl left_inverse)

lemma bigo_const_mult4:
"(c::'a::linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
by (metis bigo_elt_subset bigo_const_mult3)

lemma bigo_const_mult [simp]: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
    O(\<lambda>x. c * f x) = O(f)"
by (metis equalityI bigo_const_mult2 bigo_const_mult4)

lemma bigo_const_mult5 [simp]: "(c::'a::linordered_field) ~= 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!: subsetI simp add: bigo_def elt_set_times_def func_times)
  apply (rule_tac x = "\<lambda>y. inverse c * x y" in exI)
  apply (rename_tac g d)
  apply safe
  apply (rule_tac [2] ext)
   prefer 2
   apply simp
  apply (simp add: mult.assoc [symmetric] abs_mult)
  (* couldn't get this proof without the step above *)
proof -
  fix g :: "'b \<Rightarrow> 'a" and d :: 'a
  assume A1: "c \<noteq> (0::'a)"
  assume A2: "\<forall>x::'b. \<bar>g x\<bar> \<le> d * \<bar>f x\<bar>"
  have F1: "inverse \<bar>c\<bar> = \<bar>inverse c\<bar>" using A1 by (metis nonzero_abs_inverse)
  have F2: "(0::'a) < \<bar>c\<bar>" using A1 by (metis zero_less_abs_iff)
  have "(0::'a) < \<bar>c\<bar> \<longrightarrow> (0::'a) < \<bar>inverse c\<bar>" using F1 by (metis positive_imp_inverse_positive)
  hence "(0::'a) < \<bar>inverse c\<bar>" using F2 by metis
  hence F3: "(0::'a) \<le> \<bar>inverse c\<bar>" by (metis order_le_less)
  have "\<exists>(u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar>"
    using A2 by metis
  hence F4: "\<exists>(u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<and> (0::'a) \<le> \<bar>inverse c\<bar>"
    using F3 by metis
  hence "\<exists>(v::'a) (u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>inverse c\<bar> * \<bar>g (SKF\<^sub>7 (u * v))\<bar> \<le> u * (v * \<bar>f (SKF\<^sub>7 (u * v))\<bar>)"
    by (metis mult_left_mono)
  then show "\<exists>ca::'a. \<forall>x::'b. inverse \<bar>c\<bar> * \<bar>g x\<bar> \<le> ca * \<bar>f x\<bar>"
    using A2 F4 by (metis F1 \<open>0 < \<bar>inverse c\<bar>\<close> linordered_field_class.sign_simps(23) mult_le_cancel_left_pos)
qed

lemma bigo_const_mult6 [intro]: "(\<lambda>x. c) *o O(f) <= O(f)"
  apply (auto intro!: subsetI
    simp add: bigo_def elt_set_times_def func_times
    simp del: abs_mult ac_simps)
(* sledgehammer *)
  apply (rule_tac x = "ca * \<bar>c\<bar>" in exI)
  apply (rule allI)
  apply (subgoal_tac "ca * \<bar>c\<bar> * \<bar>f x\<bar> = \<bar>c\<bar> * (ca * \<bar>f x\<bar>)")
  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)"
by (metis bigo_const_mult1 bigo_elt_subset order_less_le psubsetD)

lemma bigo_compose1: "f =o O(g) \<Longrightarrow> (\<lambda>x. f(k x)) =o O(\<lambda>x. g(k x))"
by (unfold bigo_def, 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 [of "f - g" h k])
apply (simp add: fun_diff_def)
done

subsection \<open>Sum\<close>

lemma bigo_sum_main: "\<forall>x. \<forall>y \<in> A x. 0 <= h x y \<Longrightarrow>
    \<exists>c. \<forall>x. \<forall>y \<in> A x. \<bar>f x y\<bar> <= 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 = "\<bar>c\<bar>" in exI)
apply (subst abs_of_nonneg) back back
 apply (rule sum_nonneg)
 apply force
apply (subst sum_distrib_left)
apply (rule allI)
apply (rule order_trans)
 apply (rule sum_abs)
apply (rule sum_mono)
by (metis abs_ge_self abs_mult_pos order_trans)

lemma bigo_sum1: "\<forall>x y. 0 <= h x y \<Longrightarrow>
    \<exists>c. \<forall>x y. \<bar>f x y\<bar> <= 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)"
by (metis (no_types) bigo_sum_main)

lemma bigo_sum2: "\<forall>y. 0 <= h y \<Longrightarrow>
    \<exists>c. \<forall>y. \<bar>f y\<bar> <= c * (h y) \<Longrightarrow>
      (\<lambda>x. \<Sum>y \<in> A x. f y) =o O(\<lambda>x. \<Sum>y \<in> A x. h y)"
apply (rule bigo_sum1)
by metis+

lemma bigo_sum3: "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. \<bar>l x y * h(k x y)\<bar>)"
apply (rule bigo_sum1)
 apply (rule allI)+
 apply (rule abs_ge_zero)
apply (unfold bigo_def)
apply (auto simp add: abs_mult)
by (metis abs_ge_zero mult.left_commute mult_left_mono)

lemma bigo_sum4: "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. \<bar>l x y * h(k x y)\<bar>)"
apply (rule set_minus_imp_plus)
apply (subst fun_diff_def)
apply (subst sum_subtractf [symmetric])
apply (subst right_diff_distrib [symmetric])
apply (rule bigo_sum3)
by (metis (lifting, no_types) fun_diff_def set_plus_imp_minus ext)

lemma bigo_sum5: "f =o O(h) \<Longrightarrow> \<forall>x y. 0 <= l x y \<Longrightarrow>
    \<forall>x. 0 <= 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. \<bar>(l x y) * h(k x y)\<bar>)")
 apply (erule ssubst)
 apply (erule bigo_sum3)
apply (rule ext)
apply (rule sum.cong)
apply (rule refl)
by (metis abs_of_nonneg zero_le_mult_iff)

lemma bigo_sum6: "f =o g +o O(h) \<Longrightarrow> \<forall>x y. 0 <= l x y \<Longrightarrow>
    \<forall>x. 0 <= 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 sum_subtractf [symmetric])
  apply (subst right_diff_distrib [symmetric])
  apply (rule bigo_sum5)
  apply (subst fun_diff_def [symmetric])
  apply (drule set_plus_imp_minus)
  apply auto
done

subsection \<open>Misc useful stuff\<close>

lemma bigo_useful_intro: "A <= O(f) \<Longrightarrow> B <= O(f) \<Longrightarrow>
  A + B <= 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: "(c::'a::linordered_field) ~= 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) <= 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. f ((x::nat) + 1)) =o O(\<lambda>x. h(x + 1)) \<Longrightarrow> f 0 = 0 \<Longrightarrow>
    f =o O(h)"
apply (simp add: bigo_alt_def)
by (metis abs_ge_zero abs_mult abs_of_pos abs_zero not0_implies_Suc)

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 \<open>Less than or equal to\<close>

definition lesso :: "('a => 'b::linordered_idom) => ('a => 'b) => ('a => '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. \<bar>g x\<bar> <= \<bar>f x\<bar> \<Longrightarrow>
    g =o O(h)"
  apply (unfold bigo_def)
  apply clarsimp
apply (blast intro: order_trans)
done

lemma bigo_lesseq2: "f =o O(h) \<Longrightarrow> \<forall>x. \<bar>g x\<bar> <= f x \<Longrightarrow>
      g =o O(h)"
  apply (erule bigo_lesseq1)
apply (blast intro: abs_ge_self order_trans)
done

lemma bigo_lesseq3: "f =o O(h) \<Longrightarrow> \<forall>x. 0 <= g x \<Longrightarrow> \<forall>x. g x <= 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 <= g x \<Longrightarrow> \<forall>x. g x <= \<bar>f x\<bar> \<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 <= 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 (metis bigo_zero)
by (metis (lifting, no_types) func_zero le_fun_def le_iff_diff_le_0
      max.absorb2 order_eq_iff)

lemma bigo_lesso2: "f =o g +o O(h) \<Longrightarrow>
    \<forall>x. 0 <= k x \<Longrightarrow> \<forall>x. k x <= 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 (erule thin_rl)
(* sledgehammer *)
apply (case_tac "0 <= k x - g x")
 apply (metis (lifting) abs_le_D1 linorder_linear min_diff_distrib_left
          min.absorb1 min.absorb2 max.absorb1)
by (metis abs_ge_zero le_cases max.absorb2)

lemma bigo_lesso3: "f =o g +o O(h) \<Longrightarrow>
    \<forall>x. 0 <= k x \<Longrightarrow> \<forall>x. g x <= 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 (erule thin_rl)
(* sledgehammer *)
apply (case_tac "0 <= f x - k x")
 apply simp
 apply (subst abs_of_nonneg)
  apply (drule_tac x = x in spec) back
  apply (metis diff_less_0_iff_less linorder_not_le not_le_imp_less xt1(12) xt1(6))
 apply (metis add_minus_cancel diff_le_eq le_diff_eq uminus_add_conv_diff)
by (metis abs_ge_zero linorder_linear max.absorb1 max.commute)

lemma bigo_lesso4:
  "f <o g =o O(k::'a=>'b::{linordered_field}) \<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, assumption)
apply (erule bigo_lesseq2) back
apply (rule allI)
by (auto simp add: func_plus fun_diff_def algebra_simps
    split: split_max abs_split)

lemma bigo_lesso5: "f <o g =o O(h) \<Longrightarrow> \<exists>C. \<forall>x. f x <= g x + C * \<bar>h x\<bar>"
apply (simp only: lesso_def bigo_alt_def)
apply clarsimp
by (metis add.commute diff_le_eq)

end


theory bin_distrib
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Bin = One | ZeroAnd "Bin" | OneAnd "Bin"

fun s :: "Bin => Bin" where
"s (One) = ZeroAnd One"
| "s (ZeroAnd xs) = OneAnd xs"
| "s (OneAnd ys) = ZeroAnd (s ys)"

fun plus :: "Bin => Bin => Bin" where
"plus (One) y = s y"
| "plus (ZeroAnd z) (One) = s (ZeroAnd z)"
| "plus (ZeroAnd z) (ZeroAnd ys) = ZeroAnd (plus z ys)"
| "plus (ZeroAnd z) (OneAnd xs) = OneAnd (plus z xs)"
| "plus (OneAnd x2) (One) = s (OneAnd x2)"
| "plus (OneAnd x2) (ZeroAnd zs) = OneAnd (plus x2 zs)"
| "plus (OneAnd x2) (OneAnd ys2) = ZeroAnd (s (plus x2 ys2))"

fun times :: "Bin => Bin => Bin" where
"times (One) y = y"
| "times (ZeroAnd xs) y = ZeroAnd (times xs y)"
| "times (OneAnd ys) y = plus (ZeroAnd (times ys y)) y"

(*hipster s plus*)
lemma lemma_a [thy_expl]: "ZeroAnd x2 = plus x2 x2"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_aa [thy_expl]: "plus x2 One = s x2"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ab [thy_expl]: "s (plus x2 y2) = plus x2 (s y2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ac [thy_expl]: "plus (s x2) y2 = plus x2 (s y2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ad [thy_expl]: "plus (plus x1 x1) x1 = plus x1 (plus x1 x1)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ae [thy_expl]: "plus (s x2) (plus y2 z2) = plus (plus x2 y2) (s z2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_af [thy_expl]: "plus (s x2) (plus y2 z2) = plus (plus y2 z2) (s x2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ag [thy_expl]: "plus (plus x2 x2) (plus x2 y2) = plus (plus x2 y2) (plus x2 x2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ah [thy_expl]: "plus (plus x2 x2) (plus y2 x2) = plus (plus y2 x2) (plus x2 x2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_ai [thy_expl]: "plus (plus x2 x2) (plus y2 y2) = ZeroAnd (plus y2 x2)"
by (hipster_induct_schemes s.simps plus.simps)

lemma lemma_aj [thy_expl]: "plus x1 y1 = plus y1 x1"
by (hipster_induct_schemes s.simps plus.simps)

ML \<open>
val has_tvar = exists_type (exists_subtype (fn TVar _ => true | _ => false)) o prop_of

fun metis_method ((override_type_encs, lam_trans), ths) ctxt facts =
  let val (schem_facts, nonschem_facts) = List.partition has_tvar facts in
     (Method.insert_tac nonschem_facts THEN'
      CHANGED_PROP o Metis_Tactic.metis_tac (these override_type_encs)
        (the_default ATP_Proof_Reconstruct.default_metis_lam_trans lam_trans) ctxt (schem_facts @ ths)) end

fun simp_all ctxt lemmas =
    let
       (*val _ = Pretty.writeln (Pretty.block [Pretty.str "simp_all: ", pretty_thm ctxt thm])*)
       (*val _ = @{print} thm  OR @{make_string} *)
       (*val ss = map @{print} lemmas*)
       val ctxt' = Library.foldl (fn (ctxt,thm) => Simplifier.add_simp thm ctxt)
                                 (ctxt, lemmas)
    in
      (Simplifier.asm_full_simp_tac ctxt') end

fun simp_a ctxt facts i =
       (Method.insert_tac facts i) THEN
        (PARALLEL_GOALS o ALLGOALS o Simplifier.asm_full_simp_tac) ctxt

fun simp_or_metis ctxt (facts, lemmas) thm = (*let val _ = Pretty.writeln (pretty_thm ctxt thm) in*)
  let
    val do_full = Hip_Tac_Ops.use_full_types ctxt
    val simp_adds = filter (fn lem => hd (Hip_Tac_Ops.simp_cond ctxt) (thm,lem)) lemmas
    val metis_adds = filter (fn lem => hd (Hip_Tac_Ops.metis_cond ctxt) (thm,lem)) (facts @ lemmas)
  in
    (ALLGOALS((simp_a ctxt simp_adds) (* FIXME: both facts and lemmas? *)     (*SOLVE_TIMEOUT 2000*)
    THEN_ALL_NEW
    ((REPEAT_ALL_NEW (metis_method ((NONE,NONE), lemmas) ctxt facts)))))thm (* vs: HEADGOAL in metis_methos and REPEAT here; ALLGOALS feels safer *)
  end
\<close>

lemma lemma_ak [thy_expl]: "plus x2 (plus y2 z2) = plus y2 (plus x2 z2)"
apply(induct y2 arbitrary: x2 z2)
by (tactic \<open>simp_or_metis @{context} (@{thms plus.simps s.simps Bin.exhaust}, @{thms thy_expl})\<close>)

lemma lemma_al [thy_expl]: "plus (plus x2 y2) (plus z2 y2) = plus (plus x2 z2) (plus y2 y2)"
by (hipster_induct_schemes s.simps plus.simps)

(*hipster s plus times*)

theorem x0 :
  "!! (x :: Bin) (y :: Bin) (z :: Bin) .
     (times x (plus y z)) = (plus (times x y) (times x z))"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

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_sort_nat_SSortIsSort
  imports "../../Test_Base"
begin

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

datatype Nat = Z | S "Nat"

fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

fun ssortminimum1 :: "Nat => Nat list => Nat" where
  "ssortminimum1 x (nil2) = x"
| "ssortminimum1 x (cons2 y1 ys1) =
     (if le y1 x then ssortminimum1 y1 ys1 else ssortminimum1 x ys1)"

fun insert :: "Nat => Nat list => Nat list" where
  "insert x (nil2) = cons2 x (nil2)"
| "insert x (cons2 z xs) =
     (if le x z then cons2 x (cons2 z xs) else cons2 z (insert x xs))"

fun isort :: "Nat list => Nat list" where
  "isort (nil2) = nil2"
| "isort (cons2 y xs) = insert y (isort xs)"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

(*fun did not finish the proof*)
function ssort :: "Nat list => Nat list" where
  "ssort (nil2) = nil2"
| "ssort (cons2 y ys) =
     (let m :: Nat = ssortminimum1 y ys
     in cons2
          m
          (ssort
             (deleteBy
                (% (z :: Nat) => % (x2 :: Nat) => (z = x2)) m (cons2 y ys))))"
  by pat_completeness auto

theorem property0 :
  "((ssort xs) = (isort xs))"
  oops

end


section \<open> Weakest Prespecification \<close>

theory utp_wprespec
  imports "UTP1.utp"
begin

definition wprespec :: "('b, 'c) urel \<Rightarrow> ('a, 'c) urel \<Rightarrow> ('a, 'b) urel" (infixr "\\" 70) where
[upred_defs]: "wprespec K Y = (\<not> ((\<not> Y) ;; K\<^sup>-))"

lemma wprespec_alt_def: "P \\ Q = (\<not> P ;; (\<not> Q\<^sup>-))\<^sup>-"
  by (rel_auto)

theorem wprespec: "R \<sqsubseteq> P ;; Q \<longleftrightarrow> Q \\ R \<sqsubseteq> P"
  by (rel_auto)

lemma wprespec1: "R \<sqsubseteq> (Q \\ R) ;; Q"
  by (simp add: wprespec)

lemma wprespec2: "Q \\ (P ;; Q) \<sqsubseteq> P"
  by (meson eq_iff wprespec)

lemma wprespec3: "Q \\ R \<sqsubseteq> II \<longleftrightarrow> R \<sqsubseteq> Q"
  by (metis seqr_left_unit wprespec)

lemma wprespec4: "Q \\ Q \<sqsubseteq> II"
  by (simp add: wprespec3)

lemma wprespec5 [wp]: "II \\ P = P"
  by (metis eq_iff seqr_right_unit wprespec1 wprespec2)

lemma wprespec6 [wp]: "Q \\ (R \<and> S) = ((Q \\ R) \<and> (Q \\ S))"
  by (meson eq_iff utp_pred_laws.inf.bounded_iff wprespec)

lemma wprespec6a [wp]: "Q \\ (\<And> n\<in>A \<bullet> R(n)) = (\<And> n\<in>A \<bullet> Q \\ R(n))"
  by (rel_auto)

lemma wprespec7 [wp]: "(P \<or> Q) \\ R = ((P \\ R) \<and> (Q \\ R))"
  by (rel_auto)

lemma wprespec7a [wp]: "(\<Sqinter> i\<in>A \<bullet> P(i)) \\ R = (\<And> i\<in>A \<bullet> P(i) \\ R)"
  by (rel_auto)

lemma wprespec8 [wp]: "(P ;; Q) \\ R = P \\ Q \\ R"
  by (simp add: seqr_assoc wprespec_def)

theorem wprespec9: "Q \\ R = \<Sqinter> {Y. R \<sqsubseteq> Y ;; Q}" (is "?lhs = ?rhs")
proof (rule antisym)
  show "?lhs \<sqsubseteq> ?rhs"
    by (metis Sup_least mem_Collect_eq wprespec)
  show "?rhs \<sqsubseteq> ?lhs"
    by (simp add: Sup_upper wprespec1)
qed

theorem wprespec10: "\<lbrakk>Q \\ R\<rbrakk>\<^sub>e (s\<^sub>0, s) = (\<forall> s'. \<lbrakk>Q\<rbrakk>\<^sub>e (s, s') \<longrightarrow> \<lbrakk>R\<rbrakk>\<^sub>e (s\<^sub>0, s'))"
  by (rel_auto)

lemma wprespec12: "Q\<^sup>- = ((\<not>Q) \\ (\<not>II))"
  by (rel_auto)

lemma wprespec13: "- (Q \\ R) = (-R \\ -Q) \\ -II"
  by (rel_auto)

lemma wprespec17 [wp]: "\<langle>\<sigma>\<rangle>\<^sub>a \\ R = R ;; (\<langle>\<sigma>\<rangle>\<^sub>a \\ II)"
  by (rel_auto)

lemma wprespec17a [wp]: "\<langle>\<sigma>\<rangle>\<^sub>a \\ II = \<langle>\<sigma>\<rangle>\<^sub>a\<^sup>-"
  by (rel_auto)

theorem wlp_as_wprespec: "P wlp b = \<lfloor>P \\ b\<^sup>>\<rfloor>\<^sub>>"
  by (rel_auto)

end