(*  Title:      HOL/Types_To_Sets/Examples/T2_Spaces.thy
    Author:     Ondřej Kunčar, TU München
*)

theory T2_Spaces
  imports Complex_Main "../Types_To_Sets" Prerequisites
begin

section \<open>The Type-Based Theorem\<close>

text\<open>We relativize a theorem that contains a type class with an associated (overloaded) operation.
     The key technique is to compile out the overloaded operation by the dictionary construction
     using the Unoverloading rule.\<close>

text\<open>This is the type-based statement that we want to relativize.\<close>
thm compact_imp_closed
text\<open>The type is class a T2 typological space.\<close>
typ "'a :: t2_space"
text\<open>The associated operation is the predicate open that determines the open sets in the T2 space.\<close>
term "open"

section \<open>Definitions and Setup for The Relativization\<close>

text\<open>We gradually define relativization of topological spaces, t2 spaces, compact and closed
     predicates and prove that they are indeed the relativization of the original predicates.\<close>

definition topological_space_on_with :: "'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> bool"
  where "topological_space_on_with A \<equiv> \<lambda>open. open A \<and>
    (\<forall>S \<subseteq> A. \<forall>T \<subseteq> A. open S \<longrightarrow> open T \<longrightarrow> open (S \<inter> T))
    \<and> (\<forall>K \<subseteq> Pow A. (\<forall>S\<in>K. open S) \<longrightarrow> open (\<Union>K))"

lemma topological_space_transfer[transfer_rule]:
  includes lifting_syntax
  assumes [transfer_rule]: "right_total T" "bi_unique T"
  shows "((rel_set T ===> op=) ===> op=) (topological_space_on_with (Collect (Domainp T)))
    class.topological_space"
  unfolding topological_space_on_with_def[abs_def] class.topological_space_def[abs_def]
  apply transfer_prover_start
  apply transfer_step+
  unfolding Pow_def Ball_Collect[symmetric]
  by blast

definition t2_space_on_with :: "'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> bool"
  where "t2_space_on_with A \<equiv> \<lambda>open. topological_space_on_with A open \<and>
  (\<forall>x \<in> A. \<forall>y \<in> A. x \<noteq> y \<longrightarrow> (\<exists>U\<subseteq>A. \<exists>V\<subseteq>A. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}))"

lemma t2_space_transfer[transfer_rule]:
  includes lifting_syntax
  assumes [transfer_rule]: "right_total T" "bi_unique T"
  shows "((rel_set T ===> op=) ===> op=) (t2_space_on_with (Collect (Domainp T))) class.t2_space"
  unfolding t2_space_on_with_def[abs_def] class.t2_space_def[abs_def]
    class.t2_space_axioms_def[abs_def]
  apply transfer_prover_start
  apply transfer_step+
  unfolding Ball_Collect[symmetric]
  by blast

definition closed_with :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  where "closed_with \<equiv> \<lambda>open S. open (- S)"

lemma closed_closed_with: "closed s = closed_with open s"
  unfolding closed_with_def closed_def[abs_def] ..

definition closed_on_with :: "'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  where "closed_on_with A \<equiv> \<lambda>open S. open (-S \<inter> A)"

lemma closed_with_transfer[transfer_rule]:
  includes lifting_syntax
  assumes [transfer_rule]: "right_total T" "bi_unique T"
  shows "((rel_set T ===> op=) ===> rel_set T===> op=) (closed_on_with (Collect (Domainp T)))
    closed_with"
  unfolding closed_with_def closed_on_with_def by transfer_prover

definition compact_with :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  where "compact_with \<equiv> \<lambda>open S. (\<forall>C. (\<forall>c\<in>C. open c) \<and> S \<subseteq> \<Union>C \<longrightarrow> (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"

lemma compact_compact_with: "compact s = compact_with open s"
  unfolding compact_with_def compact_eq_heine_borel[abs_def] ..

definition compact_on_with :: "'a set \<Rightarrow> ('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  where "compact_on_with A \<equiv> \<lambda>open S. (\<forall>C\<subseteq>Pow A. (\<forall>c\<in>C. open c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
    (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"

lemma compact_on_with_subset_trans: "(\<forall>C\<subseteq>Pow A. (\<forall>c\<in>C. open' c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
  (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D)) =
  ((\<forall>C\<subseteq>Pow A. (\<forall>c\<in>C. open' c) \<and> S \<subseteq> \<Union>C \<longrightarrow> (\<exists>D\<subseteq>Pow A. D\<subseteq>C \<and> finite D \<and> S \<subseteq> \<Union>D)))"
  by (meson subset_trans)

lemma compact_with_transfer[transfer_rule]:
  includes lifting_syntax
  assumes [transfer_rule]: "right_total T" "bi_unique T"
  shows "((rel_set T ===> op=) ===> rel_set T===> op=) (compact_on_with (Collect (Domainp T)))
    compact_with"
  unfolding compact_with_def compact_on_with_def
  apply transfer_prover_start
  apply transfer_step+
  unfolding compact_on_with_subset_trans
  unfolding Pow_def Ball_Collect[symmetric] Ball_def Bex_def mem_Collect_eq
  by blast

setup \<open>Sign.add_const_constraint
  (@{const_name "open"}, SOME @{typ "'a set \<Rightarrow> bool"})\<close>

text\<open>The aforementioned development can be automated. The main part is already automated
     by the transfer_prover.\<close>

section \<open>The Relativization to The Set-Based Theorem\<close>

text\<open>The first step of the dictionary construction.\<close>
lemmas dictionary_first_step = compact_imp_closed[unfolded compact_compact_with closed_closed_with]
thm dictionary_first_step

text\<open>Internalization of the type class t2_space.\<close>
lemmas internalized_sort = dictionary_first_step[internalize_sort "'a::t2_space"]
thm internalized_sort

text\<open>We unoverload the overloaded constant open and thus finish compiling out of it.\<close>
lemmas dictionary_second_step =  internalized_sort[unoverload "open :: 'a set \<Rightarrow> bool"]
text\<open>The theorem with internalized type classes and compiled out operations is the starting point
     for the original relativization algorithm.\<close>
thm dictionary_second_step

text\<open>This is the set-based variant of the theorem compact_imp_closed.\<close>
lemma compact_imp_closed_set_based:
  assumes "(A::'a set) \<noteq> {}"
  shows "\<forall>open. t2_space_on_with A open \<longrightarrow> (\<forall>S\<subseteq>A. compact_on_with A open S \<longrightarrow>
    closed_on_with A open S)"
proof -
  {
    text\<open>We define the type 'b to be isomorphic to A.\<close>
    assume T: "\<exists>(Rep :: 'b \<Rightarrow> 'a) Abs. type_definition Rep Abs A"
    from T obtain rep :: "'b \<Rightarrow> 'a" and abs :: "'a \<Rightarrow> 'b" where t: "type_definition rep abs A"
      by auto

    text\<open>Setup for the Transfer tool.\<close>
    define cr_b where "cr_b == \<lambda>r a. r = rep a"
    note type_definition_Domainp[OF t cr_b_def, transfer_domain_rule]
    note typedef_right_total[OF t cr_b_def, transfer_rule]
    note typedef_bi_unique[OF t cr_b_def, transfer_rule]

    have ?thesis
      text\<open>Relativization by the Transfer tool.\<close>
      using dictionary_second_step[where 'a = 'b, untransferred, simplified]
      by blast

  } note * = this[cancel_type_definition, OF assms]

  show ?thesis by (rule *)
qed

setup \<open>Sign.add_const_constraint
  (@{const_name "open"}, SOME @{typ "'a::topological_space set \<Rightarrow> bool"})\<close>

text\<open>The Final Result. We can compare the type-based and the set-based statement.\<close>
thm compact_imp_closed compact_imp_closed_set_based

declare [[show_sorts]]
text\<open>The Final Result. This time with explicitly shown type-class annotations.\<close>
thm compact_imp_closed compact_imp_closed_set_based

end


(*
  File: Ring.thy
  Author: Bohua Zhan

  Rings.
*)

theory Ring
  imports Nat
begin

section \<open>Rings\<close>

definition is_ring :: "i \<Rightarrow> o" where [rewrite]:
  "is_ring(R) \<longleftrightarrow> (is_ring_raw(R) \<and> is_abgroup(R) \<and> is_monoid(R) \<and>
    is_left_distrib(R) \<and> is_right_distrib(R) \<and> \<zero>\<^sub>R \<noteq> \<one>\<^sub>R)"

lemma is_ringD [forward]:
  "is_ring(R) \<Longrightarrow> is_ring_raw(R)"
  "is_ring(R) \<Longrightarrow> is_abgroup(R)"
  "is_ring(R) \<Longrightarrow> is_monoid(R)"
  "is_ring(R) \<Longrightarrow> is_left_distrib(R)"
  "is_ring(R) \<Longrightarrow> is_right_distrib(R)" by auto2+

lemma is_ringD' [resolve]: "is_ring(R) \<Longrightarrow> \<zero>\<^sub>R \<noteq> \<one>\<^sub>R" by auto2
setup {* del_prfstep_thm_eqforward @{thm is_ring_def} *}

lemma is_ring_ring_prop [forward]:
  "is_ring_raw(H) \<Longrightarrow> is_ring(G) \<Longrightarrow> eq_str_ring(G,H) \<Longrightarrow> is_ring(H)" by auto2

setup {* fold add_rewrite_rule [
  @{thm times_commD}, @{thm left_distribD}, @{thm right_distribD}, @{thm left_distribD_back},
  @{thm right_distribD_back}] *}

lemma comm_distribs [forward]:
  "is_ring_raw(R) \<Longrightarrow> is_left_distrib(R) \<Longrightarrow> is_times_comm(R) \<Longrightarrow> is_right_distrib(R)" by auto2

lemma ring_mult0_left [rewrite]: "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<zero>\<^sub>R *\<^sub>R x = \<zero>\<^sub>R"
@proof @have "\<zero>\<^sub>R *\<^sub>R x +\<^sub>R \<zero>\<^sub>R *\<^sub>R x = (\<zero>\<^sub>R +\<^sub>R \<zero>\<^sub>R) *\<^sub>R x +\<^sub>R \<zero>\<^sub>R" @qed

lemma ring_mult0_right [rewrite]: "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> x *\<^sub>R \<zero>\<^sub>R = \<zero>\<^sub>R"
@proof @have "x *\<^sub>R \<zero>\<^sub>R +\<^sub>R x *\<^sub>R \<zero>\<^sub>R = x *\<^sub>R (\<zero>\<^sub>R +\<^sub>R \<zero>\<^sub>R) +\<^sub>R \<zero>\<^sub>R" @qed

lemma units_non_zero [forward]: "is_ring(R) \<Longrightarrow> x \<in> units(R) \<Longrightarrow> x \<noteq> \<zero>\<^sub>R"
@proof @obtain "y\<in>.R" where "y *\<^sub>R x = \<one>\<^sub>R" @qed

lemma ring_mult_sign_l [rewrite]:
  "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> (-\<^sub>R x) *\<^sub>R y = -\<^sub>R (x *\<^sub>R y) \<and> x *\<^sub>R y \<in>. R"
@proof @have "(-\<^sub>R x) *\<^sub>R y +\<^sub>R x *\<^sub>R y = \<zero>\<^sub>R" @qed

lemma ring_mult_sign_r [rewrite]:
  "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R (-\<^sub>R y) = -\<^sub>R (x *\<^sub>R y) \<and> x *\<^sub>R y \<in>. R"
@proof @have "x *\<^sub>R (-\<^sub>R y) +\<^sub>R x *\<^sub>R y = \<zero>\<^sub>R" @qed

lemma ring_mult_sign_both [rewrite]:
  "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> (-\<^sub>R x) *\<^sub>R (-\<^sub>R y) = x *\<^sub>R y" by auto2

section \<open>Commutative rings\<close>

definition is_comm_ring :: "i \<Rightarrow> o" where [rewrite]:
  "is_comm_ring(R) \<longleftrightarrow> (is_ring(R) \<and> is_times_comm(R))"

lemma is_comm_ringD [forward]:
  "is_comm_ring(R) \<Longrightarrow> is_ring(R)"
  "is_comm_ring(R) \<Longrightarrow> is_times_comm(R)" by auto2+
setup {* del_prfstep_thm_eqforward @{thm is_comm_ring_def} *}

lemma is_comm_ring_ring_prop [forward]:
  "is_ring_raw(H) \<Longrightarrow> is_comm_ring(G) \<Longrightarrow> eq_str_ring(G,H) \<Longrightarrow> is_comm_ring(H)" by auto2

lemma comm_ring_is_unit [forward]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> y *\<^sub>R x = \<one>\<^sub>R \<Longrightarrow> x \<in> units(R)" by auto2

lemma comm_ring_is_unit2 [forward]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R y = \<one>\<^sub>R \<Longrightarrow> x \<in> units(R)" by auto2

lemma comm_ring_prod_unit [forward]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R y \<in> units(R) \<Longrightarrow> x \<in> units(R) \<and> y \<in> units(R)"
@proof
  @obtain "z\<in>.R" where "z *\<^sub>R (x *\<^sub>R y) = \<one>\<^sub>R" "(x *\<^sub>R y) *\<^sub>R z = \<one>\<^sub>R"
  @have "(y *\<^sub>R z) *\<^sub>R x = \<one>\<^sub>R" @have "y *\<^sub>R (x *\<^sub>R z) = (y *\<^sub>R x) *\<^sub>R z"
@qed

lemma inv_distrib_comm_ring [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R y \<in> units(R) \<Longrightarrow>
   inv(R, x *\<^sub>R y) = inv(R,y) *\<^sub>R inv(R,x) \<and> x \<in> units(R) \<and> y \<in> units(R) \<and>
   inv(R,y) \<in>. R \<and> inv(R,x) \<in>. R"
@proof @have "inv(R,y) *\<^sub>R inv(R,x) *\<^sub>R (x *\<^sub>R y) = inv(R,y) *\<^sub>R (inv(R,x) *\<^sub>R x) *\<^sub>R y" @qed

lemma comm_ring_prod_is_unit [backward1, backward2]:
  "is_comm_ring(R) \<Longrightarrow> x \<in> units(R) \<Longrightarrow> y \<in> units(R) \<Longrightarrow> x *\<^sub>R y \<in> units(R)"
@proof @have "inv(R,y) *\<^sub>R inv(R,x) *\<^sub>R (x *\<^sub>R y) = inv(R,y) *\<^sub>R (inv(R,x) *\<^sub>R x) *\<^sub>R y" @qed

section \<open>of\_nat on rings\<close>

(* Recursion on x:
    of_nat(0) = 0
  | of_nat(n + 1) = of_nat(n) + 1
*)
definition of_nat :: "i \<Rightarrow> i \<Rightarrow> i" where [rewrite_bidir]:
  "of_nat(R,x) = nat_act(R,x,\<one>\<^sub>R)"
setup {* register_wellform_data ("of_nat(R,x)", ["x \<in> nat"]) *}

lemma of_nat_zero [rewrite_bidir]: "is_ring(R) \<Longrightarrow> of_nat(R,0) = \<zero>\<^sub>R" by auto2
lemma of_nat_one [rewrite_bidir]: "is_ring(R) \<Longrightarrow> of_nat(R,1) = \<one>\<^sub>R" by auto2
lemma of_nat_type [typing]: "is_ring(R) \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(R,n) \<in>. R" by auto2

abbreviation ZeroR ("0\<^sub>_" [91] 90) where "0\<^sub>R \<equiv> of_nat(R,0)"
abbreviation OneR ("1\<^sub>_" [91] 90) where "1\<^sub>R \<equiv> of_nat(R,1)"
abbreviation TwoR ("2\<^sub>_" [91] 90) where "2\<^sub>R \<equiv> of_nat(R,2)"
abbreviation ThreeR ("3\<^sub>_" [91] 90) where "3\<^sub>R \<equiv> of_nat(R,3)"
abbreviation FourR ("4\<^sub>_" [91] 90) where "4\<^sub>R \<equiv> of_nat(R,4)"
abbreviation FiveR ("5\<^sub>_" [91] 90) where "5\<^sub>R \<equiv> of_nat(R,5)"
abbreviation NegOneR ("-1\<^sub>_" [91] 90) where "-1\<^sub>R \<equiv> -\<^sub>R of_nat(R,1)"

lemma of_nat_add:
  "is_comm_ring(R) \<Longrightarrow> x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> of_nat(R,x) +\<^sub>R of_nat(R,y) = of_nat(R, x +\<^sub>\<nat> y) \<and> x +\<^sub>\<nat> y \<in> nat" by auto2
setup {* add_rewrite_rule_cond @{thm of_nat_add}
  (with_conds ["?x \<noteq> 0", "?x \<noteq> Suc(?z)", "?y \<noteq> 0", "?y \<noteq> Suc(?z)"]) *}

lemma add_monomial_same:
  "is_ring(R) \<Longrightarrow> p \<in>. R \<Longrightarrow> p +\<^sub>R p = p *\<^sub>R 2\<^sub>R \<and> 2 \<in> nat \<and> 2\<^sub>R \<in>. R"
@proof @have "2 = 1 +\<^sub>\<nat> 1" @qed

setup {* del_prfstep_thm_str "" @{thm of_nat_def} *}

lemma of_nat_add_back [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. \<nat> \<Longrightarrow> y \<in>. \<nat> \<Longrightarrow> of_nat(R, x +\<^sub>\<nat> y) = of_nat(R,x) +\<^sub>R of_nat(R,y)" by auto2

lemma of_nat_mult:
  "is_comm_ring(R) \<Longrightarrow> x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> of_nat(R,x) *\<^sub>R of_nat(R,y) = of_nat(R, x *\<^sub>\<nat> y) \<and> x *\<^sub>\<nat> y \<in> nat"
@proof @var_induct "x \<in> nat" @qed
setup {* add_rewrite_rule_cond @{thm of_nat_mult}
  (with_conds ["?x \<noteq> 0", "?x \<noteq> Suc(?z)", "?y \<noteq> 0", "?y \<noteq> Suc(?z)"]) *}

lemma of_nat_mult_back [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> x \<in>. \<nat> \<Longrightarrow> y \<in>. \<nat> \<Longrightarrow> of_nat(R, x *\<^sub>\<nat> y) = of_nat(R,x) *\<^sub>R of_nat(R,y)" by auto2

lemma of_nat_sub1 [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> x \<ge>\<^sub>\<nat> y \<Longrightarrow> of_nat(R,x) +\<^sub>R -\<^sub>R of_nat(R,y) = of_nat(R,x -\<^sub>\<nat> y) \<and> x -\<^sub>\<nat> y \<in> nat"
@proof @have "(of_nat(R,x) -\<^sub>R of_nat(R,y)) +\<^sub>R of_nat(R,y) = of_nat(R, x -\<^sub>\<nat> y) +\<^sub>R of_nat(R,y)" @qed

lemma of_nat_sub2:
  "is_comm_ring(R) \<Longrightarrow> x \<le>\<^sub>\<nat> y \<Longrightarrow> of_nat(R,x) +\<^sub>R -\<^sub>R of_nat(R,y) = -\<^sub>R of_nat(R,y -\<^sub>\<nat> x) \<and>
     y -\<^sub>\<nat> x \<in> nat \<and> of_nat(R,y -\<^sub>\<nat> x) \<in>. R"
@proof @have "of_nat(R,x) +\<^sub>R -\<^sub>R of_nat(R,y) = -\<^sub>R (of_nat(R,y) +\<^sub>R -\<^sub>R of_nat(R,x))" @qed

lemma of_nat_sub_back [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> x \<ge>\<^sub>\<nat> y \<Longrightarrow> of_nat(R,x -\<^sub>\<nat> y) = of_nat(R,x) -\<^sub>R of_nat(R,y)"
@proof @have "of_nat(R,x) -\<^sub>R of_nat(R,y) = of_nat(R,x) +\<^sub>R -\<^sub>R of_nat(R,y)" @qed

lemma add_monomial_l [rewrite]:
  "is_ring(R) \<Longrightarrow> p \<in>. R \<Longrightarrow> r \<in>. R \<Longrightarrow> p +\<^sub>R p *\<^sub>R r = p *\<^sub>R (1\<^sub>R +\<^sub>R r) \<and>
   1 \<in> nat \<and> 1\<^sub>R \<in>. R \<and> 1\<^sub>R +\<^sub>R r \<in>. R" by auto2

lemma neg_is_minus_1:
  "is_ring(R) \<Longrightarrow> p \<in>. R \<Longrightarrow> -\<^sub>R p = p *\<^sub>R -1\<^sub>R \<and> 1 \<in> nat \<and> 1\<^sub>R \<in>. R \<and> -1\<^sub>R \<in>. R" by auto2

setup {* fold del_prfstep_thm [@{thm of_nat_sub1}, @{thm add_monomial_l}] *}

section \<open>Division in commutative rings\<close>

definition divide :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where [rewrite]:
  "divide(G,x,y) = (THE z. z \<in>. G \<and> z *\<^sub>G y = x)"
abbreviation divide_notation ("(_/ '/\<^sub>_ _)" [70,70,71] 70) where "x /\<^sub>G y \<equiv> divide(G,x,y)"
setup {* register_wellform_data ("x /\<^sub>G y", ["x \<in>. G", "y \<in> units(G)"]) *}

setup {* add_gen_prfstep ("ring_inv_case",
  [WithProperty @{term_pat "is_ring(?R)"}, WithTerm @{term_pat "inv(?R,?x)"},
   CreateConcl @{term_pat "?x \<in> units(?R)"}]) *}

setup {* add_gen_prfstep ("ring_div_case",
  [WithProperty @{term_pat "is_ring(?R)"}, WithTerm @{term_pat "?x /\<^sub>?R ?y"},
   CreateConcl @{term_pat "?y \<in> units(?R)"}]) *}

lemma divide_exist [resolve]:
  "is_comm_ring(G) \<Longrightarrow> x \<in>. G \<Longrightarrow> y \<in> units(G) \<Longrightarrow> (x *\<^sub>G inv(G,y)) *\<^sub>G y = x"
@proof @have "(x *\<^sub>G inv(G,y)) *\<^sub>G y = x *\<^sub>G (inv(G,y) *\<^sub>G y)" @qed

lemma divide_type [typing]:
  "is_comm_ring(G) \<Longrightarrow> x \<in>. G \<Longrightarrow> y \<in> units(G) \<Longrightarrow> x /\<^sub>G y \<in>. G"
@proof @have "(x *\<^sub>G inv(G,y)) *\<^sub>G y = x" @qed

lemma divideD [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> x \<in>. G \<Longrightarrow> y \<in> units(G) \<Longrightarrow> x /\<^sub>G y = x *\<^sub>G inv(G,y) \<and> inv(G,y) \<in>. G"
@proof @have "(x *\<^sub>G inv(G,y)) *\<^sub>G y = x" @qed
setup {* del_prfstep_thm @{thm divide_def} *}

lemma comm_ring_divide_1:
  "is_comm_ring(G) \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(G,n) = of_nat(G,n) /\<^sub>G 1\<^sub>G \<and>
   of_nat(G,n) \<in>. G \<and> 1 \<in> nat \<and> 1\<^sub>G \<in> units(G)" by auto2

lemma comm_ring_neg_divide_1:
  "is_comm_ring(G) \<Longrightarrow> n \<in> nat \<Longrightarrow> -\<^sub>G of_nat(G,n) = -\<^sub>G of_nat(G,n) /\<^sub>G 1\<^sub>G \<and>
   of_nat(G,n) \<in>. G \<and> -\<^sub>G of_nat(G,n) \<in>. G \<and> 1 \<in> nat \<and> 1\<^sub>G \<in> units(G)" by auto2

lemma comm_ring_divide_1_back [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> p /\<^sub>G 1\<^sub>G = p" by auto2

lemma comm_ring_zero_divide [rewrite]:
  "is_comm_ring(R) \<Longrightarrow> a \<in> units(R) \<Longrightarrow> 0\<^sub>R /\<^sub>R a = 0\<^sub>R" by auto2

lemma comm_ring_zero_divide' [forward]:
  "is_comm_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in> units(R) \<Longrightarrow> a /\<^sub>R b = 0\<^sub>R \<Longrightarrow> a = 0\<^sub>R"
@proof @have "a /\<^sub>R b *\<^sub>R b = a" @qed

lemma divide_cancel_right [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> x \<in>. G \<Longrightarrow> y \<in>. G \<Longrightarrow> z \<in>. G \<Longrightarrow> y *\<^sub>G z \<in> units(G) \<Longrightarrow>
   (x *\<^sub>G z) /\<^sub>G (y *\<^sub>G z) = x /\<^sub>G y \<and> y \<in> units(G)"
@proof @have "(x *\<^sub>G z) *\<^sub>G (inv(G,z) *\<^sub>G inv(G,y)) = x *\<^sub>G (z *\<^sub>G inv(G,z)) *\<^sub>G inv(G,y)" @qed

lemma divide_cancel_left [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> x \<in>. G \<Longrightarrow> y \<in>. G \<Longrightarrow> z \<in>. G \<Longrightarrow> z *\<^sub>G y \<in> units(G) \<Longrightarrow>
   (z *\<^sub>G x) /\<^sub>G (z *\<^sub>G y) = x /\<^sub>G y \<and> y \<in> units(G)"
@proof @have "z *\<^sub>G x = x *\<^sub>G z" @have "z *\<^sub>G y = y *\<^sub>G z" @qed

lemma divide_cross:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> r \<in>. G \<Longrightarrow> s \<in> units(G) \<Longrightarrow>
   p /\<^sub>G q +\<^sub>G r /\<^sub>G s = (p *\<^sub>G s +\<^sub>G q *\<^sub>G r) /\<^sub>G (q *\<^sub>G s) \<and>
   q \<in>. G \<and> s \<in>. G \<and> p *\<^sub>G s \<in>. G \<and> q *\<^sub>G r \<in>. G \<and> p *\<^sub>G s +\<^sub>G q *\<^sub>G r \<in>. G \<and> q *\<^sub>G s \<in> units(G)"
@proof @have "(p *\<^sub>G s +\<^sub>G q *\<^sub>G r) /\<^sub>G (q *\<^sub>G s) = (p *\<^sub>G s) /\<^sub>G (q *\<^sub>G s) +\<^sub>G (q *\<^sub>G r) /\<^sub>G (q *\<^sub>G s)" @qed

lemma divide_mult:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> r \<in>. G \<Longrightarrow> s \<in> units(G) \<Longrightarrow>
   (p /\<^sub>G q) *\<^sub>G (r /\<^sub>G s) = (p *\<^sub>G r) /\<^sub>G (q *\<^sub>G s) \<and>
   q \<in>. G \<and> s \<in>. G \<and> p *\<^sub>G r \<in>. G \<and> q *\<^sub>G s \<in> units(G)"
@proof
  @have "(p *\<^sub>G inv(G,q)) *\<^sub>G (r *\<^sub>G inv(G,s)) = p *\<^sub>G (inv(G,q) *\<^sub>G r) *\<^sub>G inv(G,s)"
  @have "p *\<^sub>G (r *\<^sub>G inv(G,q)) *\<^sub>G inv(G,s) = (p *\<^sub>G r) *\<^sub>G (inv(G,q) *\<^sub>G inv(G,s))"
@qed

lemma comm_ring_units_minus [typing]:
  "is_comm_ring(G) \<Longrightarrow> p \<in> units(G) \<Longrightarrow> -\<^sub>G p \<in> units(G)"
@proof
  @obtain "q\<in>.G" where "p *\<^sub>G q = \<one>\<^sub>G" @have "(-\<^sub>G p) *\<^sub>G (-\<^sub>G q) = p *\<^sub>G q"
@qed

lemma comm_ring_units_minus_back [typing]:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> -\<^sub>G p \<in> units(G) \<Longrightarrow> p \<in> units(G)"
@proof
  @obtain "q\<in>.G" where "(-\<^sub>G p) *\<^sub>G q = \<one>\<^sub>G" @have "p *\<^sub>G (-\<^sub>G q) = -\<^sub>G p *\<^sub>G q"
@qed

lemma inv_neg [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> -\<^sub>G p \<in> units(G) \<Longrightarrow> inv(G, -\<^sub>G p) = -\<^sub>G (inv(G,p)) \<and>
   p \<in> units(G) \<and> inv(G,p) \<in>. G"
@proof @have "-\<^sub>G p *\<^sub>G (-\<^sub>G inv(G,p)) = \<one>\<^sub>G" @qed

lemma divide_inv [rewrite]:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> p /\<^sub>G q \<in> units(G) \<Longrightarrow>
   inv(G,p /\<^sub>G q) = q /\<^sub>G p \<and> p \<in> units(G) \<and> q \<in>. G" by auto2

lemma divide_inv2:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> (-\<^sub>G p) /\<^sub>G q \<in> units(G) \<Longrightarrow>
   inv(G,(-\<^sub>G p) /\<^sub>G q) = (-\<^sub>G q) /\<^sub>G p \<and> p \<in> units(G) \<and> q \<in>. G \<and> -\<^sub>G q \<in>. G"
@proof
  @have "(-\<^sub>G p) /\<^sub>G q = -\<^sub>G (p /\<^sub>G q)"
  @have "p = -\<^sub>G (-\<^sub>G p)"
  @have "(-\<^sub>G q) /\<^sub>G p = -\<^sub>G (q /\<^sub>G p)"
@qed

lemma uminus_zero:
  "is_comm_ring(G) \<Longrightarrow> -\<^sub>G 0\<^sub>G = 0\<^sub>G \<and> 0 \<in> nat" by auto2

lemma uminus_inv1:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> -\<^sub>G (p /\<^sub>G q) = (-\<^sub>G p) /\<^sub>G q \<and> -\<^sub>G p \<in>. G" by auto2

lemma uminus_inv2:
  "is_comm_ring(G) \<Longrightarrow> p \<in>. G \<Longrightarrow> q \<in> units(G) \<Longrightarrow> -\<^sub>G (-\<^sub>G p /\<^sub>G q) = p /\<^sub>G q" by auto2

setup {* fold del_prfstep_thm [@{thm times_commD}, @{thm left_distribD}, @{thm right_distribD},
  @{thm left_distribD_back}, @{thm right_distribD_back}] *}
setup {* fold del_prfstep_thm [@{thm ring_mult_sign_both}, @{thm divide_exist}, @{thm divideD},
  @{thm divide_cancel_left}, @{thm divide_cancel_right}, @{thm divide_inv}] *}

lemma zero_l': "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> 0\<^sub>R +\<^sub>R x = x" by auto2
lemma unit_l': "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> 1\<^sub>R *\<^sub>R x = x" by auto2
lemma mult_zero_l': "is_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> 0\<^sub>R *\<^sub>R x = 0\<^sub>R" by auto2
lemma inv_l': "is_ring(R) \<Longrightarrow> x \<in> units(R) \<Longrightarrow> inv(R,x) *\<^sub>R x = 1\<^sub>R \<and> 1 \<in> nat" by auto2
lemma of_nat_zero': "is_ring(R) \<Longrightarrow> \<zero>\<^sub>R = of_nat(R,0) \<and> 0 \<in> nat" by auto2
lemma of_nat_one': "is_ring(R) \<Longrightarrow> \<one>\<^sub>R = of_nat(R,1) \<and> 1 \<in> nat" by auto2

ML_file "rat_arith.ML"
ML_file "alg_ring.ML"
ML_file "alg_ring_test.ML"

section \<open>Integral domain\<close>

definition integral_domain :: "i \<Rightarrow> o" where [rewrite]:
  "integral_domain(R) \<longleftrightarrow> (is_comm_ring(R) \<and> (\<forall>x\<in>.R. \<forall>y\<in>.R. x *\<^sub>R y = \<zero>\<^sub>R \<longrightarrow> x = \<zero>\<^sub>R \<or> y = \<zero>\<^sub>R))"

lemma integral_domainD [forward]:
  "integral_domain(R) \<Longrightarrow> is_comm_ring(R)"
  "integral_domain(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R y = \<zero>\<^sub>R \<Longrightarrow> x \<noteq> \<zero>\<^sub>R \<Longrightarrow> y = \<zero>\<^sub>R"
  "integral_domain(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> x *\<^sub>R y = \<zero>\<^sub>R \<Longrightarrow> y \<noteq> \<zero>\<^sub>R \<Longrightarrow> x = \<zero>\<^sub>R" by auto2+
setup {* del_prfstep_thm_eqforward @{thm integral_domain_def} *}

lemma integral_domain_cancel_right [forward]:
  "integral_domain(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> z \<noteq> \<zero>\<^sub>R \<Longrightarrow> x *\<^sub>R z = y *\<^sub>R z \<Longrightarrow> x = y"
@proof @have "x *\<^sub>R z -\<^sub>R y *\<^sub>R z = (x -\<^sub>R y) *\<^sub>R z" @qed

lemma integral_domain_cancel_left [forward]:
  "integral_domain(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> z \<noteq> \<zero>\<^sub>R \<Longrightarrow> z *\<^sub>R x = z *\<^sub>R y \<Longrightarrow> x = y"
@proof @have "z *\<^sub>R x -\<^sub>R z *\<^sub>R y = z *\<^sub>R (x -\<^sub>R y)" @qed

section \<open>Ordered rings\<close>

definition is_ord_ring :: "i \<Rightarrow> o" where [rewrite]:
  "is_ord_ring(R) \<longleftrightarrow> (is_ord_ring_raw(R) \<and> is_comm_ring(R) \<and> linorder(R) \<and>
                       ord_ring_add_left(R) \<and> ord_ring_mult_pos(R))"

lemma is_ord_ringD [forward]:
  "is_ord_ring(R) \<Longrightarrow> is_ord_ring_raw(R)"
  "is_ord_ring(R) \<Longrightarrow> is_comm_ring(R)"
  "is_ord_ring(R) \<Longrightarrow> linorder(R)"
  "is_ord_ring(R) \<Longrightarrow> ord_ring_add_left(R)"
  "is_ord_ring(R) \<Longrightarrow> ord_ring_mult_pos(R)" by auto2+
setup {* del_prfstep_thm_eqforward @{thm is_ord_ring_def} *}

lemma is_ord_ring_prop [forward]:
  "is_ord_ring(R) \<Longrightarrow> is_ord_ring_raw(S) \<Longrightarrow> eq_str_ord_ring(R,S) \<Longrightarrow> is_ord_ring(S)" by auto2

(* Usually we don't convert > to \<noteq>, but this case is especially frequent. *)
lemma ord_ring_nonzero [forward]:
  "is_ord_ring(R) \<Longrightarrow> x >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x \<noteq> \<zero>\<^sub>R"
  "is_ord_ring(R) \<Longrightarrow> x <\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x \<noteq> \<zero>\<^sub>R" by auto2+

lemma ord_ring_ordered_left_iff [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> z +\<^sub>R x \<le>\<^sub>R z +\<^sub>R y \<longleftrightarrow> x \<le>\<^sub>R y"
@proof @have "x = (-\<^sub>R z) +\<^sub>R (x +\<^sub>R z)" @have "y = (-\<^sub>R z) +\<^sub>R (y +\<^sub>R z)" @qed

lemma ord_ring_ordered_right_iff [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> x +\<^sub>R z \<le>\<^sub>R y +\<^sub>R z \<longleftrightarrow> x \<le>\<^sub>R y"
@proof @have "x +\<^sub>R z = z +\<^sub>R x" @have "y +\<^sub>R z = z +\<^sub>R y" @qed

(* The main results for automatic simplification *)
lemma ord_ring_le_switch_left:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> (x \<le>\<^sub>R y \<longleftrightarrow> 0\<^sub>R \<le>\<^sub>R y -\<^sub>R x) \<and> y -\<^sub>R x \<in>. R \<and> 0\<^sub>R \<in>. R \<and> 0 \<in> nat"
@proof @contradiction @have "0\<^sub>R +\<^sub>R x = y -\<^sub>R x +\<^sub>R x" @qed

lemma ord_ring_less_switch_left:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> (x <\<^sub>R y \<longleftrightarrow> 0\<^sub>R <\<^sub>R y -\<^sub>R x) \<and> y -\<^sub>R x \<in>. R \<and> 0\<^sub>R \<in>. R \<and> 0 \<in> nat"
@proof @contradiction @have "0\<^sub>R +\<^sub>R x = y -\<^sub>R x +\<^sub>R x" @qed
ML_file "ord_ring_steps.ML"

lemma ord_ring_single_less_add [backward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<zero>\<^sub>R <\<^sub>R y \<Longrightarrow> x <\<^sub>R x +\<^sub>R y" by auto2

lemma ord_ring_single_less_sub [backward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<zero>\<^sub>R <\<^sub>R y \<Longrightarrow> x >\<^sub>R x -\<^sub>R y" by auto2

lemma ord_ring_single_le_add [backward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<zero>\<^sub>R \<le>\<^sub>R y \<Longrightarrow> x \<le>\<^sub>R x +\<^sub>R y" by auto2

lemma ord_ring_mix1 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> p \<le>\<^sub>R q \<Longrightarrow> r \<le>\<^sub>R s \<Longrightarrow> p +\<^sub>R r \<le>\<^sub>R q +\<^sub>R s"
@proof @have "p +\<^sub>R r \<le>\<^sub>R p +\<^sub>R s" @qed

lemma ord_ring_mix2 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> p \<le>\<^sub>R q \<Longrightarrow> r <\<^sub>R s \<Longrightarrow> p +\<^sub>R r <\<^sub>R q +\<^sub>R s"
@proof @have "p +\<^sub>R r <\<^sub>R p +\<^sub>R s" @qed

lemma ord_ring_mix3 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> p <\<^sub>R q \<Longrightarrow> r \<le>\<^sub>R s \<Longrightarrow> p +\<^sub>R r <\<^sub>R q +\<^sub>R s"
@proof @have "p +\<^sub>R r <\<^sub>R q +\<^sub>R r" @qed

lemma ord_ring_strict_ordered_left_iff [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> z +\<^sub>R x <\<^sub>R z +\<^sub>R y \<longleftrightarrow> x <\<^sub>R y" by auto2

lemma ord_ring_strict_ordered_right_iff [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z \<in>. R \<Longrightarrow> x +\<^sub>R z <\<^sub>R y +\<^sub>R z \<longleftrightarrow> x <\<^sub>R y" by auto2

lemma ord_ring_ge_equiv [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> p \<in>. R \<Longrightarrow> q \<in>. R \<Longrightarrow> p -\<^sub>R q \<ge>\<^sub>R \<zero>\<^sub>R \<longleftrightarrow> p \<ge>\<^sub>R q" by auto2

lemma ord_ring_gt_equiv [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> p \<in>. R \<Longrightarrow> q \<in>. R \<Longrightarrow> p -\<^sub>R q >\<^sub>R \<zero>\<^sub>R \<longleftrightarrow> p >\<^sub>R q" by auto2

lemma ord_ring_mult_le_right [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<ge>\<^sub>R y \<Longrightarrow> z \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x *\<^sub>R z \<ge>\<^sub>R y *\<^sub>R z"
@proof
  @have "x -\<^sub>R y \<ge>\<^sub>R \<zero>\<^sub>R"
  @have "x *\<^sub>R z -\<^sub>R y *\<^sub>R z = (x -\<^sub>R y) *\<^sub>R z"
  @have "x *\<^sub>R z -\<^sub>R y *\<^sub>R z \<ge>\<^sub>R \<zero>\<^sub>R"
@qed

lemma ord_ring_mult_le_left [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> x \<ge>\<^sub>R y \<Longrightarrow> z \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> z *\<^sub>R x \<ge>\<^sub>R z *\<^sub>R y"
@proof @have "x *\<^sub>R z \<ge>\<^sub>R y *\<^sub>R z" @qed

lemma ord_ring_mult_lt_right [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> x >\<^sub>R y \<Longrightarrow> z >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x *\<^sub>R z >\<^sub>R y *\<^sub>R z"
@proof @have "x \<noteq> y" @have "x *\<^sub>R z \<noteq> y *\<^sub>R z" @qed

lemma ord_ring_mult_lt_left [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> x >\<^sub>R y \<Longrightarrow> z >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> z *\<^sub>R x >\<^sub>R z *\<^sub>R y"
@proof @have "x *\<^sub>R z >\<^sub>R y *\<^sub>R z" @qed

lemma ord_ring_mult_mix [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> p \<ge>\<^sub>R q \<Longrightarrow> q \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> s \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> r \<ge>\<^sub>R s \<Longrightarrow> p *\<^sub>R r \<ge>\<^sub>R q *\<^sub>R s"
@proof @have "p *\<^sub>R r \<ge>\<^sub>R q *\<^sub>R r" @qed

lemma ord_ring_mult_mix2 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> p >\<^sub>R q \<Longrightarrow> q >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> s >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> r \<ge>\<^sub>R s \<Longrightarrow> p *\<^sub>R r >\<^sub>R q *\<^sub>R s"
@proof @have "p *\<^sub>R r >\<^sub>R q *\<^sub>R r" @qed

lemma ord_ring_mult_mix3 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> p \<ge>\<^sub>R q \<Longrightarrow> q >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> s >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> r >\<^sub>R s \<Longrightarrow> p *\<^sub>R r >\<^sub>R q *\<^sub>R s"
  by auto2

lemma ord_ring_neg_ge_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> -\<^sub>R a \<le>\<^sub>R \<zero>\<^sub>R" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_neg_ge_zero} [with_term "-\<^sub>?R ?a"] *}

lemma ord_ring_neg_gt_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> -\<^sub>R a <\<^sub>R \<zero>\<^sub>R" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_neg_gt_zero} [with_term "-\<^sub>?R ?a"] *}

lemma ord_ring_neg_le_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> -\<^sub>R a \<ge>\<^sub>R \<zero>\<^sub>R" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_neg_le_zero} [with_term "-\<^sub>?R ?a"] *}

lemma ord_ring_neg_lt_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a <\<^sub>R \<zero>\<^sub>R \<Longrightarrow> -\<^sub>R a >\<^sub>R \<zero>\<^sub>R" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_neg_lt_zero} [with_term "-\<^sub>?R ?a"] *}

lemma ord_ring_mult_pos_neg [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R b \<le>\<^sub>R \<zero>\<^sub>R"
@proof @have "a *\<^sub>R (-\<^sub>R b) \<ge>\<^sub>R \<zero>\<^sub>R" @qed
setup {* add_forward_prfstep_cond @{thm ord_ring_mult_pos_neg} [with_term "?a *\<^sub>?R ?b"] *}

lemma ord_ring_mult_neg_pos [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R b \<le>\<^sub>R \<zero>\<^sub>R"
@proof @contradiction @have "b *\<^sub>R a \<ge>\<^sub>R \<zero>\<^sub>R" @qed
setup {* add_forward_prfstep_cond @{thm ord_ring_mult_neg_pos} [with_term "?a *\<^sub>?R ?b"] *}

lemma ord_field_mult_le_cancel_right [forward]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> y \<in>. R \<Longrightarrow> z >\<^sub>R \<zero>\<^sub>R \<Longrightarrow>
   x *\<^sub>R z \<ge>\<^sub>R y *\<^sub>R z \<Longrightarrow> x \<ge>\<^sub>R y" by auto2

lemma ord_ring_mult_neg [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b \<le>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R b \<ge>\<^sub>R \<zero>\<^sub>R"
@proof @have "(-\<^sub>R a) *\<^sub>R (-\<^sub>R b) \<ge>\<^sub>R \<zero>\<^sub>R" @qed
setup {* add_forward_prfstep_cond @{thm ord_ring_mult_neg} [with_term "?a *\<^sub>?R ?b"] *}

lemma ord_ring_square_ge_zero [resolve]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a *\<^sub>R a \<ge>\<^sub>R \<zero>\<^sub>R"
@proof @case "a \<ge>\<^sub>R \<zero>\<^sub>R" @qed

lemma ord_ring_square_gt_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> a \<noteq> \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R a >\<^sub>R \<zero>\<^sub>R"
@proof @have  "a *\<^sub>R a \<noteq> \<zero>\<^sub>R" @qed

lemma ord_ring_one_ge_zero [resolve]:
  "is_ord_ring(R) \<Longrightarrow> \<one>\<^sub>R >\<^sub>R \<zero>\<^sub>R"
@proof @have "\<one>\<^sub>R = \<one>\<^sub>R *\<^sub>R \<one>\<^sub>R" @qed

lemma ord_ring_mult_pos_strict [backward1]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> a >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R b >\<^sub>R \<zero>\<^sub>R" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_mult_pos_strict} [with_term "?a *\<^sub>?R ?b"] *}

lemma ord_ring_mult_pos_neg_strict [backward1]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> a >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b <\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a *\<^sub>R b <\<^sub>R \<zero>\<^sub>R" by auto2

lemma ord_ring_nonneg_add [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a +\<^sub>R b \<ge>\<^sub>R \<zero>\<^sub>R" by auto2

lemma ord_ring_pos_add1 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a +\<^sub>R b >\<^sub>R \<zero>\<^sub>R" by auto2

lemma ord_ring_pos_add2 [backward1, backward2]:
  "is_ord_ring(R) \<Longrightarrow> a \<ge>\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> a +\<^sub>R b >\<^sub>R \<zero>\<^sub>R" by auto2

lemma ord_ring_le_to_lt_plus_one [backward]:
  "is_ord_ring(R) \<Longrightarrow> x \<le>\<^sub>R y \<Longrightarrow> x <\<^sub>R y +\<^sub>R \<one>\<^sub>R"
@proof @have "x +\<^sub>R \<zero>\<^sub>R <\<^sub>R y +\<^sub>R \<one>\<^sub>R" @qed

lemma ord_ring_le_minus_switch [rewrite]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> b \<in>. R \<Longrightarrow> -\<^sub>R a \<le>\<^sub>R -\<^sub>R b \<longleftrightarrow> a \<ge>\<^sub>R b" by auto2

lemma ord_ring_le_minus_switch2 [resolve]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> -\<^sub>R a \<le>\<^sub>R b \<Longrightarrow> a \<ge>\<^sub>R -\<^sub>R b" by auto2

lemma ord_ring_le_minus_switch3 [resolve]:
  "is_ord_ring(R) \<Longrightarrow> a \<in>. R \<Longrightarrow> -\<^sub>R a \<ge>\<^sub>R b \<Longrightarrow> a \<le>\<^sub>R -\<^sub>R b" by auto2

lemma ord_ring_of_nat_Suc:
  "is_ord_ring(R) \<Longrightarrow> n \<in>. \<nat> \<Longrightarrow> of_nat(R,n) <\<^sub>R of_nat(R, n +\<^sub>\<nat> 1)" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_of_nat_Suc} [with_term "of_nat(?R, ?n +\<^sub>\<nat> 1)"] *}

lemma ord_ring_of_nat_ge_zero [backward]:
  "is_ord_ring(R) \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(R,n) \<ge>\<^sub>R \<zero>\<^sub>R"
@proof @var_induct "n \<in> nat" @qed
setup {* del_prfstep_thm @{thm ord_ring_of_nat_Suc} *}

lemma ord_field_char_zero' [backward]:
  "is_ord_ring(R) \<Longrightarrow> n \<in> nat \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> of_nat(R,n) >\<^sub>R \<zero>\<^sub>R"
@proof @obtain "m\<in>.\<nat>" where "n = m +\<^sub>\<nat> 1" @have "of_nat(R,m) \<ge>\<^sub>R \<zero>\<^sub>R" @qed

lemma ord_ring_of_nat_le [backward]:
  "is_ord_ring(R) \<Longrightarrow> m \<le>\<^sub>\<nat> n \<Longrightarrow> of_nat(R,m) \<le>\<^sub>R of_nat(R,n)"
@proof @obtain "p\<in>.\<nat>" where "n = m +\<^sub>\<nat> p" @qed

lemma ord_ring_of_nat_less [backward]:
  "is_ord_ring(R) \<Longrightarrow> m <\<^sub>\<nat> n \<Longrightarrow> of_nat(R,m) <\<^sub>R of_nat(R,n)"
@proof @obtain "p\<in>nat" where "p\<noteq>0" "n = m +\<^sub>\<nat> p" @qed

lemma ord_ring_of_nat_le_back [forward]:
  "is_ord_ring(R) \<Longrightarrow> m \<in> nat \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(R,m) \<le>\<^sub>R of_nat(R,n) \<Longrightarrow> m \<le>\<^sub>\<nat> n"
@proof @have "\<not>of_nat(R,n) <\<^sub>R of_nat(R,m)" @qed

lemma ord_ring_of_nat_eq [forward]:
  "is_ord_ring(R) \<Longrightarrow> m \<in> nat \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(R,m) = of_nat(R,n) \<Longrightarrow> m = n"
@proof
  @case "m <\<^sub>\<nat> n" @with @have "of_nat(R,m) <\<^sub>R of_nat(R,n)" @end
  @case "m >\<^sub>\<nat> n" @with @have "of_nat(R,m) >\<^sub>R of_nat(R,n)" @end
@qed

lemma ord_ring_of_nat_ge_one [backward]:
  "is_ord_ring(R) \<Longrightarrow> a \<in> nat \<Longrightarrow> b \<in> nat \<Longrightarrow> of_nat(R,a) >\<^sub>R of_nat(R,b) \<Longrightarrow>
   of_nat(R,a) \<ge>\<^sub>R of_nat(R,b) +\<^sub>R 1\<^sub>R"
@proof @have "of_nat(R,b) +\<^sub>R 1\<^sub>R = of_nat(R, b +\<^sub>\<nat> 1)" @qed

lemma ord_ring_has_pos_greater [backward]:
  "is_ord_ring(R) \<Longrightarrow> x \<in>. R \<Longrightarrow> \<exists>y\<in>.R. y >\<^sub>R \<zero>\<^sub>R \<and> y \<ge>\<^sub>R x"
@proof @let "m = max(R,\<one>\<^sub>R,x)" @have "\<one>\<^sub>R >\<^sub>R \<zero>\<^sub>R" @qed

lemma ord_ring_is_unbounded [forward]:
  "is_ord_ring(R) \<Longrightarrow> order_unbounded(R)"
@proof
  @have (@rule) "\<forall>x\<in>.R. \<exists>y. y <\<^sub>R x" @with
    @have "x <\<^sub>R x +\<^sub>R 1\<^sub>R" @have "x -\<^sub>R 1\<^sub>R <\<^sub>R x" @end
  @have (@rule) "\<forall>x\<in>.R. \<exists>y. y >\<^sub>R x" @with @have "x +\<^sub>R 1\<^sub>R >\<^sub>R x" @end
@qed

lemma power_gt_0 [backward]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> e \<in> nat \<Longrightarrow> b >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> b ^\<^sub>R e >\<^sub>R \<zero>\<^sub>R"
@proof @var_induct "e \<in> nat" @qed

lemma power_gt_n [resolve]: "is_ord_ring(R) \<Longrightarrow> n \<in> nat \<Longrightarrow> of_nat(R,n) <\<^sub>R 2\<^sub>R ^\<^sub>R n"
@proof
  @var_induct "n \<in> nat" @with
    @subgoal "n = n' +\<^sub>\<nat> 1" @have "2\<^sub>R ^\<^sub>R (n' +\<^sub>\<nat> 1) = 2\<^sub>R ^\<^sub>R n' +\<^sub>R 2\<^sub>R ^\<^sub>R n'" @endgoal
  @end
@qed

section \<open>Subsets of an ordered ring\<close>

definition pos_elts :: "i \<Rightarrow> i" where [rewrite]:
  "pos_elts(R) = {x\<in>.R. x >\<^sub>R \<zero>\<^sub>R}"

lemma pos_eltsD [forward]: "x \<in> pos_elts(R) \<Longrightarrow> x \<in>. R \<and> x >\<^sub>R \<zero>\<^sub>R" by auto2
lemma pos_eltsI [backward2]: "x \<in>. R \<Longrightarrow> x >\<^sub>R \<zero>\<^sub>R \<Longrightarrow> x \<in> pos_elts(R)" by auto2
lemma pos_elts_one [resolve]: "is_ord_ring(R) \<Longrightarrow> \<one>\<^sub>R \<in> pos_elts(R)" by auto2
lemma pos_elts_mult [typing]:
  "is_ord_ring(R) \<Longrightarrow> integral_domain(R) \<Longrightarrow> x \<in> pos_elts(R) \<Longrightarrow> y \<in> pos_elts(R) \<Longrightarrow> x *\<^sub>R y \<in> pos_elts(R)" by auto2
lemma pos_elts_add [typing]:
  "is_ord_ring(R) \<Longrightarrow> x \<in> pos_elts(R) \<Longrightarrow> y \<in> pos_elts(R) \<Longrightarrow> x +\<^sub>R y \<in> pos_elts(R)" by auto2

section \<open>Construction of ordered ring from non-negative elements\<close>

(* See Bourbaki, Algebra VI.2.1 *)

definition subset_add_closed :: "i \<Rightarrow> i \<Rightarrow> o" where [rewrite]:
  "subset_add_closed(R,S) \<longleftrightarrow> (\<forall>x\<in>S. \<forall>y\<in>S. x +\<^sub>R y \<in> S)"

lemma subset_add_closedD [typing]:
  "subset_add_closed(R,S) \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x +\<^sub>R y \<in> S" by auto2
setup {* del_prfstep_thm_eqforward @{thm subset_add_closed_def} *}

definition subset_mult_closed :: "i \<Rightarrow> i \<Rightarrow> o" where [rewrite]:
  "subset_mult_closed(R,S) \<longleftrightarrow> (\<forall>x\<in>S. \<forall>y\<in>S. x *\<^sub>R y \<in> S)"

lemma subset_mult_closedD [typing]:
  "subset_mult_closed(R,S) \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x *\<^sub>R y \<in> S" by auto2
setup {* del_prfstep_thm_eqforward @{thm subset_mult_closed_def} *}

definition nonneg_compat_inter :: "i \<Rightarrow> i \<Rightarrow> o" where [rewrite]:
  "nonneg_compat_inter(R,S) \<longleftrightarrow> (\<forall>x\<in>S. -\<^sub>R x \<in> S \<longrightarrow> x = \<zero>\<^sub>R)"

lemma nonneg_compat_interD [forward]:
  "nonneg_compat_inter(R,S) \<Longrightarrow> -\<^sub>R x \<in> S \<Longrightarrow> x \<in> S \<Longrightarrow> x = \<zero>\<^sub>R" by auto2
setup {* del_prfstep_thm_eqforward @{thm nonneg_compat_inter_def} *}

definition nonneg_compat_union :: "i \<Rightarrow> i \<Rightarrow> o" where [rewrite]:
  "nonneg_compat_union(R,S) \<longleftrightarrow> (\<forall>x\<in>.R. x \<in> S \<or> -\<^sub>R x \<in> S)"

lemma nonneg_compat_unionD [forward]:
  "x \<in>. R \<Longrightarrow> nonneg_compat_union(R,S) \<Longrightarrow> -\<^sub>R x \<notin> S \<Longrightarrow> x \<in> S" by auto2
setup {* del_prfstep_thm_eqforward @{thm nonneg_compat_union_def} *}

definition ord_ring_from_nonneg :: "i \<Rightarrow> i \<Rightarrow> i" where [rewrite]:
  "ord_ring_from_nonneg(R,S) =
    OrdRing(carrier(R), \<zero>\<^sub>R, \<lambda>x y. x +\<^sub>R y, \<one>\<^sub>R, \<lambda>x y. x *\<^sub>R y, \<lambda>x y. y -\<^sub>R x \<in> S)"

definition nonneg_compat :: "i \<Rightarrow> i \<Rightarrow> o" where [rewrite]:
  "nonneg_compat(R,S) \<longleftrightarrow>
    (\<zero>\<^sub>R \<in> S \<and> subset_add_closed(R,S) \<and> subset_mult_closed(R,S) \<and>
     nonneg_compat_inter(R,S) \<and> nonneg_compat_union(R,S))"

lemma ord_ring_from_nonneg_is_ord_ring_raw [forward]:
  "is_ring_raw(R) \<Longrightarrow> ord_ring_form(ord_ring_from_nonneg(R,S))" by auto2

lemma ord_ring_from_nonneg_eq_str:
  "is_ring_raw(R) \<Longrightarrow> eq_str_ring(R,ord_ring_from_nonneg(R,S))" by auto2
setup {* add_forward_prfstep_cond @{thm ord_ring_from_nonneg_eq_str} [with_term "ord_ring_from_nonneg(?R,?S)"] *}

lemma ord_ring_from_nonneg_eval [rewrite]:
  "is_ring_raw(R) \<Longrightarrow> A = ord_ring_from_nonneg(R,S) \<Longrightarrow> is_abgroup(A) \<Longrightarrow>
   x \<in>. A \<Longrightarrow> y \<in>. A \<Longrightarrow> x \<le>\<^sub>A y \<longleftrightarrow> y -\<^sub>A x \<in> S" by auto2
setup {* del_prfstep_thm @{thm ord_ring_from_nonneg_def} *}

lemma ord_ring_from_nonneg_is_linorder [forward]:
  "is_ring_raw(R) \<Longrightarrow> A = ord_ring_from_nonneg(R,S) \<Longrightarrow> is_comm_ring(A) \<Longrightarrow>
   nonneg_compat(A,S) \<Longrightarrow> linorder(A)"
@proof
  @have "\<forall>x y z. x \<le>\<^sub>A y \<longrightarrow> y \<le>\<^sub>A z \<longrightarrow> x \<le>\<^sub>A z" @with
    @have "z -\<^sub>A x = (z -\<^sub>A y) +\<^sub>A (y -\<^sub>A x)" @end
  @have "\<forall>x y. x \<le>\<^sub>A y \<longrightarrow> y \<le>\<^sub>A x \<longrightarrow> x = y" @with
    @have "-\<^sub>A (y -\<^sub>A x) = x -\<^sub>A y" @end
  @have "\<forall>x\<in>.A. \<forall>y\<in>.A. x \<le>\<^sub>A y \<or> x \<ge>\<^sub>A y" @with
    @have "-\<^sub>A (y -\<^sub>A x) = x -\<^sub>A y" @end
@qed

lemma ord_ring_from_nonneg_compat_plus [forward]:
  "is_ring_raw(R) \<Longrightarrow> A = ord_ring_from_nonneg(R,S) \<Longrightarrow> is_comm_ring(A) \<Longrightarrow>
   nonneg_compat(A,S) \<Longrightarrow> ord_ring_add_left(A)"
@proof
  @have "\<forall>a\<in>.A. \<forall>b c. b \<le>\<^sub>A c \<longrightarrow> a +\<^sub>A b \<le>\<^sub>A a +\<^sub>A c" @with
    @have "(a +\<^sub>R c) -\<^sub>R (a +\<^sub>R b) = c -\<^sub>R b" @end
@qed

lemma ord_ring_from_nonneg_is_ord_ring [forward]:
  "is_ring_raw(R) \<Longrightarrow> A = ord_ring_from_nonneg(R,S) \<Longrightarrow> is_comm_ring(A) \<Longrightarrow>
   nonneg_compat(A,S) \<Longrightarrow> is_ord_ring(ord_ring_from_nonneg(R,S))" by auto2

end


(*  Title:       Instances of Schneider's generalized protocol of clock synchronization
    Author:      Damián Barsotti <damian at hal.famaf.unc.edu.ar>, 2006
    Maintainer:  Damián Barsotti <damian at hal.famaf.unc.edu.ar>
*)

section \<open>Fault-tolerant Midpoint algorithm\<close>

theory LynchInstance imports Complex_Main begin

text \<open>This algorithm is presented in \<^cite>\<open>"lynch_cs"\<close>.\<close>

subsection \<open>Model of the system\<close>

text \<open>The main ideas for the formalization of the system were
obtained from \<^cite>\<open>"shankar92mechanical"\<close>.\<close>

subsubsection \<open>Types in the formalization\<close>

text \<open>The election of the basics types was based on
\<^cite>\<open>"shankar92mechanical"\<close>. There, the process are natural numbers and
the real time and the clock readings are reals.\<close>

type_synonym process = nat
type_synonym time = real      \<comment> \<open>real time\<close>
type_synonym Clocktime = real \<comment> \<open>time of the clock readings (clock time)\<close>

subsubsection \<open>Some constants\<close>

text\<open>Here we define some parameters of the algorithm that we use:
the number of process and the number of lowest and highest readed
values that the algorithm discards. The defined constants must satisfy
this axiom. If not, the algorithm cannot obtain the maximum and
minimum value, because it will have discarded all the values.\<close>

axiomatization
  np  :: nat  \<comment> \<open>Number of processes\<close> and
  khl :: nat  \<comment> \<open>Number of lowest and highest values\<close> where
  constants_ax: "2 * khl < np"

text \<open>We define also the set of process that the algorithm
manage. This definition exist only for readability matters.\<close>

definition
PR :: "process set" where
[simp]: "PR = {..<np}"

subsubsection \<open>Convergence function\<close>

text \<open>This functions is called ``Fault-tolerant Midpoint''
(\<^cite>\<open>"schneider87understanding"\<close>)\<close>

text \<open>In this algorithm each process has an array where it store the
clocks readings from the others processes (including itself). We
formalise that as a function from processes to clock time as
\<^cite>\<open>"shankar92mechanical"\<close>.\<close>

text \<open>First we define two functions. They take a function of clock
readings and a set of processes and they return a set of @{term khl}
processes which has the greater (smaller) clock readings. They were
defined with the Hilbert's $\varepsilon$-operator (the indefinite
description operator \<open>SOME\<close> in Isabelle) because in this way the
formalization is not fixed to a particular eleccion of the processes's
readings to discards and then the modelization is more general.\<close>

definition
kmax :: "(process \<Rightarrow> Clocktime) \<Rightarrow> process set \<Rightarrow> process set" where
"kmax f P = (SOME S. S \<subseteq> P \<and> card S = khl \<and>
                (\<forall> i\<in>S. \<forall> j\<in>(P-S). f j <= f i))"

definition
kmin :: "(process \<Rightarrow> Clocktime) \<Rightarrow> process set \<Rightarrow> process set" where
"kmin f P = (SOME S. S \<subseteq> P \<and> card S = khl \<and>
                (\<forall> i\<in>S. \<forall> j\<in>(P-S). f i <= f j))"

text \<open>With the previus functions we define a new one @{term
reduce}\footnote{The name of this function was taken from
\<^cite>\<open>"lynch_cs"\<close>.}. This take a function of clock readings and a set of
processes and return de set of readings of the not dicarded
processes. In order to define this function we use the image operator
(@{term "(`)"}) of Isabelle.\<close>

definition
reduce :: "(process \<Rightarrow> Clocktime) \<Rightarrow> process set \<Rightarrow> Clocktime set" where
"reduce f P = f ` (P - (kmax f P \<union> kmin f P))"

text \<open>And finally the convergence function. This is defined with the
builtin @{term Max} and @{term Min} functions of Isabelle.
\<close>

definition
cfnl :: "process  \<Rightarrow> (process \<Rightarrow> Clocktime) \<Rightarrow> Clocktime" where
"cfnl p f = (Max (reduce f PR) + Min (reduce f PR)) / 2"

subsection \<open>Translation Invariance property.\<close>

subsubsection \<open>Auxiliary lemmas\<close>

text \<open>These lemmas proves the existence of the maximum and minimum
of the image of a set, if the set is finite and not empty.\<close>

(* The proofs are almost the same one that those of the lemmas @{thm *)
(* [source] ex_Max} and @{thm [source] ex_Min} in the Isabelle's standard *)
(* theories. *)

lemma ex_Maxf:
fixes S and f :: "'a \<Rightarrow> ('b::linorder)"
  assumes fin: "finite S"
  shows "S \<noteq> {} ==> \<exists>m\<in>S. \<forall>s \<in> S. f s \<le> f m"
using fin
proof (induct)
  case empty thus ?case by simp
next
  case (insert x S)
  show ?case
  proof (cases)
    assume "S = {}" thus ?thesis by simp
  next
    assume nonempty: "S \<noteq> {}"
    then obtain m where m: "m\<in>S" "\<forall>s\<in>S. f s \<le> f m"
      using insert by blast
    show ?thesis
    proof (cases)
      assume "f x \<le> f m" thus ?thesis using m by blast
    next
      assume "~ f x \<le> f m" thus ?thesis using m
        by(simp add:linorder_not_le order_less_le)
          (blast intro: order_trans)
    qed
  qed
qed

lemma ex_Minf:
fixes S and f :: "'a \<Rightarrow> ('b::linorder)"
  assumes fin: "finite S"
  shows "S \<noteq> {} ==> \<exists>m\<in>S. \<forall>s \<in> S. f m \<le> f s"
using fin
proof (induct)
  case empty thus ?case by simp
next
  case (insert x S)
  show ?case
  proof (cases)
    assume "S = {}" thus ?thesis by simp
  next
    assume nonempty: "S \<noteq> {}"
    then obtain m where m: "m\<in>S" "\<forall>s\<in>S. f m \<le> f s"
      using insert by blast
    show ?thesis
    proof (cases)
      assume "f m \<le> f x" thus ?thesis using m by blast
    next
      assume "~ f m \<le> f x" thus ?thesis using m
        by(simp add:linorder_not_le order_less_le)
          (blast intro: order_trans)
    qed
  qed
qed

text \<open>This trivial lemma is needed by the next two.\<close>

lemma khl_bound: "khl < np"
  using constants_ax by arith

text \<open>The next two lemmas prove that de functions kmin and kmax
return some values that satisfy their definition. This is not trivial
because we need to prove the existence of these values, according to
the rule of the Hilbert's operator. We will need this lemma many
times because is the only thing that we know about these functions.\<close>

lemma kmax_prop:
fixes f :: "nat \<Rightarrow> Clocktime"
  shows
"(kmax f PR) \<subseteq> PR \<and> card (kmax f PR) = khl \<and>
                (\<forall>i\<in>(kmax f PR). \<forall>j\<in>PR - (kmax f PR). f j \<le> f i)"
proof-
  have "khl <= np \<longrightarrow>
    (\<exists> S. S \<subseteq> PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f j \<le> f i))"
    ( is "khl <= np \<longrightarrow> ?P khl" )
  proof(induct (khl))
    have "?P 0" by force
    thus "0 <= np \<longrightarrow> ?P 0" ..
  next
    fix n
    assume asm: "n <= np \<longrightarrow> ?P n"
    show "Suc n <= np \<longrightarrow> ?P (Suc n)"
    proof
      assume asm2: "Suc n <= np"
      with asm have "?P n" by simp
      then obtain S where
        SinPR : "S\<subseteq>PR" and
        cardS: "card S = n" and
        HI: "(\<forall>i\<in>S. \<forall>j\<in>PR - S. f j \<le> f i)"
        by blast
      let ?e = "SOME i. i\<in>PR-S \<and>
        (\<forall>j\<in>PR-S. f j \<le> f i)"
      let ?S = "insert  ?e S"
      have "\<exists>i. i\<in>PR-S \<and> (\<forall>j\<in>PR-S. f j \<le> f i)"
      proof-
        from SinPR and finite_subset
        have "finite (PR-S)"
          by auto
        moreover
        from cardS and asm2 SinPR
        have "S\<subset>PR" by auto
        hence "PR-S \<noteq> {}" by auto
        ultimately
        show ?thesis using ex_Maxf by blast
      qed
      hence
        ePRS: "?e \<in> PR-S" and maxH: "(\<forall>j \<in> PR-S. f j \<le> f ?e)"
        by (auto dest!: someI_ex)
      from maxH and HI
      have "(\<forall>i\<in>?S. \<forall>j\<in>PR - ?S. f j \<le> f i)"
        by blast
      moreover
      from SinPR and finite_subset
      cardS and ePRS
      have "card ?S = Suc n"
        by (auto dest: card_insert_disjoint)
      moreover
      have "?S \<subseteq> PR" using SinPR and ePRS by auto
      ultimately
      show "?P (Suc n)" by blast
    qed
  qed
  hence "?P khl" using khl_bound by auto
  then obtain S where
    "S\<le>PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f j \<le> f i)" ..
    thus ?thesis by (unfold kmax_def)
      (rule someI [where P="\<lambda>S. S \<subseteq> PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f j \<le> f i)"])
qed

lemma kmin_prop:
fixes f :: "nat \<Rightarrow> Clocktime"
  shows
"(kmin f PR) \<subseteq> PR \<and> card (kmin f PR) = khl \<and>
                (\<forall>i\<in>(kmin f PR). \<forall>j\<in>PR - (kmin f PR). f i \<le> f j)"
proof-
  have "khl <= np \<longrightarrow>
    (\<exists> S. S \<subseteq> PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f i \<le> f j))"
    ( is "khl <= np \<longrightarrow> ?P khl" )
  proof(induct (khl))
    have "?P 0" by force
    thus "0 <= np \<longrightarrow> ?P 0" ..
  next
    fix n
    assume asm: "n <= np \<longrightarrow> ?P n"
    show "Suc n <= np \<longrightarrow> ?P (Suc n)"
    proof
      assume asm2: "Suc n <= np"
      with asm have "?P n" by simp
      then obtain S where
        SinPR : "S\<subseteq>PR" and
        cardS: "card S = n" and
        HI: "(\<forall>i\<in>S. \<forall>j\<in>PR - S. f i \<le> f j)"
        by blast
      let ?e = "SOME i. i\<in>PR-S \<and>
        (\<forall>j\<in>PR-S. f i \<le> f j)"
      let ?S = "insert  ?e S"
      have "\<exists>i. i\<in>PR-S \<and> (\<forall>j\<in>PR-S. f i \<le> f j)"
      proof-
        from SinPR and finite_subset
        have "finite (PR-S)"
          by auto
        moreover
        from cardS and asm2 SinPR
        have "S\<subset>PR" by auto
        hence "PR-S \<noteq> {}" by auto
        ultimately
        show ?thesis using ex_Minf by blast
      qed
      hence
        ePRS: "?e \<in> PR-S" and minH: "(\<forall>j \<in> PR-S. f ?e \<le> f j)"
        by (auto dest!: someI_ex)
      from minH and  HI
      have "(\<forall>i\<in>?S. \<forall>j\<in>PR - ?S. f i \<le> f j)"
        by blast
      moreover
      from SinPR and finite_subset and
        cardS and ePRS
      have "card ?S = Suc n"
        by (auto dest: card_insert_disjoint)
      moreover
      have "?S \<subseteq> PR" using SinPR and ePRS by auto
      ultimately
      show "?P (Suc n)" by blast
    qed
  qed
  hence "?P khl" using khl_bound by auto
  then obtain S where
    "S\<le>PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f i \<le> f j)" ..
    thus ?thesis by (unfold kmin_def)
      (rule someI [where P="\<lambda>S. S \<subseteq> PR \<and> card S = khl \<and> (\<forall>i\<in>S. \<forall>j\<in>PR - S. f i \<le> f j)"])
qed

text \<open>The next two lemmas are trivial from the previous ones\<close>

lemma finite_kmax:
"finite (kmax f PR)"
proof-
  have "finite PR" by auto
  with  kmax_prop and finite_subset show ?thesis
    by blast
qed

lemma finite_kmin:
"finite (kmin f PR)"
proof-
  have "finite PR" by auto
  with  kmin_prop and finite_subset show ?thesis
    by blast
qed

text \<open>This lemma is necesary because the definition of the
convergence function use the builtin Max and Min.\<close>

lemma reduce_not_empty:
"reduce f PR \<noteq> {}"
proof-
  from constants_ax have
    "0 < (np - 2 * khl)" by arith
  also
  {
    from kmax_prop kmin_prop
    have "card (kmax f PR) = khl \<and> card (kmin f PR) = khl"
      by blast
    hence "card (kmax f PR \<union> kmin f PR) <= 2 * khl"
    using card_Un_le[of "kmax f PR" "kmin f PR"] by simp
  }
  hence
    "... <= card PR - card (kmax f PR \<union> kmin f PR)"
    by simp
  also
  {
    from kmax_prop and kmin_prop have
    "(kmax f PR \<union> kmin f PR) \<subseteq> PR" by blast
  }
  hence
    "... = card (PR-(kmax f PR \<union> kmin f PR))"
    apply (intro card_Diff_subset[THEN sym])
    apply (rule finite_subset)
    by auto
    (* by (intro card_Diff_subset,auto) *)
  finally
  have "0 < card (PR-(kmax f PR \<union> kmin f PR))" .
  hence "(PR-(kmax f PR \<union> kmin f PR)) \<noteq> {}"
    by (intro notI, simp only: card_0_eq, simp)
  thus ?thesis
    by (auto simp add: reduce_def)
qed

text \<open>The next three are the main lemmas necessary for prove the
Translation Invariance property.\<close>

lemma reduce_shift:
fixes f :: "nat \<Rightarrow> Clocktime"
  shows
  "f ` (PR - (kmax f PR \<union> kmin f PR)) =
            f ` (PR - (kmax (\<lambda> p. f p + c) PR \<union> kmin (\<lambda> p. f p + c) PR))"
apply (unfold kmin_def kmax_def)
by simp

lemma max_shift:
fixes f :: "nat \<Rightarrow> Clocktime" and S
assumes notEmpFin: "S \<noteq> {}" "finite S"
shows
"Max (f`S) + x = Max ( (\<lambda> p. f p + x) ` S) "
proof-
  from notEmpFin have "f`S \<noteq> {}" and "(\<lambda> p. f p + x) ` S \<noteq> {}"
    by auto
  with notEmpFin have
    "Max (f`S) \<in> f ` S " "Max ((\<lambda> p. f p + x)`S) \<in> (\<lambda> p. f p + x) ` S "
    "(\<forall>fs \<in> (f`S). fs \<le> Max (f`S))"
    "(\<forall>fs \<in> ((\<lambda> p. f p + x)`S). fs \<le> Max ((\<lambda> p. f p + x)`S))"
    by auto
  thus ?thesis by force
qed

lemma min_shift:
fixes f :: "nat \<Rightarrow> Clocktime" and S
assumes notEmpFin: "S \<noteq> {}" "finite S"
shows
"Min (f`S) + x = Min ( (\<lambda> p. f p + x) ` S) "
proof-
  from notEmpFin have "f`S \<noteq> {}" and "(\<lambda> p. f p + x) ` S \<noteq> {}"
    by auto
  with notEmpFin have
    "Min (f`S) \<in> f ` S " "Min ((\<lambda> p. f p + x)`S) \<in> (\<lambda> p. f p + x) ` S "
    "(\<forall>fs \<in> (f`S). Min (f`S) <= fs)"
    "(\<forall>fs \<in> ((\<lambda> p. f p + x)`S). Min ((\<lambda> p. f p + x)`S) <= fs)"
    by auto
  thus ?thesis by force
qed

subsubsection \<open>Main theorem\<close>

theorem trans_inv:
fixes f :: "nat \<Rightarrow> Clocktime"
  shows
"cfnl p f + x = cfnl p (\<lambda> p. f p + x)"
proof-
  have "cfnl p (\<lambda> p. f p + x) =
      (Max (reduce (\<lambda> p. f p + x) PR) + Min (reduce (\<lambda> p. f p + x) PR)) / 2"
    by (unfold cfnl_def, simp)
  also
  have "... =
    (Max ((\<lambda> p. f p + x) `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))) +
     Min ((\<lambda> p. f p + x) `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR)))) / 2"
    by (unfold reduce_def, simp)
  also
  have
    "... =
    (Max (f `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))) + x +
     Min (f `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))) + x ) / 2"
  proof-
    have "finite (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))"
      by auto
    moreover
    from reduce_not_empty have
      "PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR) \<noteq> {}"
      by (auto simp add: reduce_def)
    ultimately
    have
      "Max ((\<lambda> p. f p + x) `
       (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR)))
      =
       Max (f `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))) + x"
       and
      "Min ((\<lambda> p. f p + x) `
       (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR)))
      =
       Min (f `
             (PR - (kmax (\<lambda> p. f p + x) PR \<union> kmin (\<lambda> p. f p + x) PR))) + x"
      using max_shift and min_shift
      by auto
    thus ?thesis by auto
  qed
  also
  from reduce_shift
  have
    "... =
    (Max (f `
             (PR - (kmax f  PR \<union> kmin f PR))) + x +
     Min (f `
             (PR - (kmax f PR \<union> kmin f PR))) + x ) / 2"
    by auto
  also
  have "... = ((Max (reduce f PR)+ x) + (Min (reduce f PR) + x)) / 2"
    by (auto simp add: reduce_def)
  also
  have "... = (Max (reduce f PR) + Min (reduce f PR)) / 2 + x"
    by auto
  finally
  show ?thesis by (auto simp add: cfnl_def)
qed

subsection \<open>Precision Enhancement property\<close>

text \<open>An informal proof of this theorem can be found in \<^cite>\<open>"miner93"\<close>\<close>

subsubsection \<open>Auxiliary lemmas\<close>

text \<open>This first lemma is most important for prove the
property. This is a consecuence of the @{thm [source] card_Un_Int}
lemma\<close>

lemma pigeonhole:
assumes
  finitA: "finite A" and
  Bss: "B \<subseteq> A" and Css: "C \<subseteq> A" and
  cardH: "card A + k <= card B + card C"
shows "k <= card (B \<inter> C)"
proof-
  from Bss Css have "B \<union> C \<subseteq> A" by blast
  with finitA have "card (B \<union> C) <= card A"
    by (simp add: card_mono)
  with cardH have
      h: "k <= card B + card C - card (B \<union> C)"
    by arith
  from finitA Bss Css and finite_subset
  have "finite B \<and> finite C" by auto
  thus ?thesis
    using card_Un_Int and h by force
qed

text \<open>This lemma is a trivial consecuence of the previous one. With
only this lemma we can prove the Precision Enhancement property with
the bound $\pi(x,y) = x + y$. But this bound not satisfy the property
\[ \pi(2\Lambda + 2 \beta\rho, \delta_S + 2\rho(r_{max}+\beta) +
2\Lambda) \leq \delta_S
\] that is used in \<^cite>\<open>"shankar92mechanical"\<close> for prove the
Schneider's schema.\<close>

lemma subsets_int:
assumes
  finitA: "finite A" and
  Bss: "B \<subseteq> A" and Css: "C \<subseteq> A" and
  cardH: "card A < card B + card C"
shows
  "B \<inter> C \<noteq> {}"
proof-
  from finitA Bss Css cardH
  have "1 <= card (B \<inter> C)"
    by (auto intro!:  pigeonhole)
  thus ?thesis by auto
qed

text \<open>This lemma is true because @{term "reduce f PR"} is the image
of @{term "PR-(kmax f PR \<union> kmin f PR)"} by the function @{term f}.\<close>

lemma exist_reduce:
"\<forall> c \<in> reduce f PR. \<exists> i\<in> PR-(kmax f PR \<union> kmin f PR). f i = c"
proof
fix c assume asm: "c \<in> reduce f PR"
thus "\<exists> i\<in> PR-(kmax f PR \<union> kmin f PR). f i = c"
  by (auto simp add: reduce_def kmax_def kmin_def)
qed

text \<open>The next three lemmas are consequence of the definition of
@{term reduce}, @{term kmax} and @{term kmin}\<close>

lemma finite_reduce:
"finite (reduce f PR)"
proof(unfold reduce_def)
  show "finite (f ` (PR - (kmax f PR \<union> kmin f PR)))"
    by auto
qed

lemma kmax_ge:
  "\<forall> i\<in> (kmax f PR). \<forall> r \<in> (reduce f PR). r <= f i "
proof
  fix i assume asm: "i \<in> kmax f PR"
  show "\<forall>r\<in>reduce f PR. r \<le> f i"
  proof
    fix r assume asm2: "r \<in> reduce f PR"
    show "r \<le> f i"
    proof-
      from asm2 and exist_reduce have
        "\<exists> j \<in> PR-(kmax f PR \<union> kmin f PR). f j = r" by blast
      then obtain j
      where fjr:"j \<in> PR-(kmax f PR \<union> kmin f PR) \<and> f j = r"
        by blast
      hence "j \<in> (PR - kmax f PR)"
        by blast
      from this fjr asm
      show ?thesis using kmax_prop
        by auto
    qed
  qed
qed

lemma kmin_le:
  "\<forall> i\<in> (kmin f PR). \<forall> r \<in> (reduce f PR). f i <= r "
proof
  fix i assume asm: "i \<in> kmin f PR"
  show "\<forall>r\<in>reduce f PR. f i \<le> r"
  proof
    fix r assume asm2: "r \<in> reduce f PR"
    show "f i <= r"
    proof-
      from asm2 and exist_reduce have
        "\<exists> j\<in> PR-(kmax f PR \<union> kmin f PR). f j = r" by blast
      then obtain j
      where fjr:"j \<in> PR-(kmax f PR \<union> kmin f PR) \<and> f j = r"
        by blast
      hence "j \<in> (PR - kmin f PR)"
        by blast
      from this fjr asm
      show ?thesis using kmin_prop
        by auto
    qed
  qed
qed

text \<open>The next lemma is used for prove the Precision Enhancement
property. This has been proved in ICS. The proof is in the appendix
\ref{sec:abs_distrib_mult}.  This cannot be prove by a simple \<open>arith\<close> or \<open>auto\<close> tactic.\<close>

text\<open>This lemma is true also with \<open>0 <= c\<close> !!\<close>

lemma abs_distrib_div:
  "0 < (c::real)  \<Longrightarrow> \<bar>a / c - b / c\<bar> = \<bar>a - b\<bar> / c"
proof-
  assume ch: "0<c"
  {
    fix d :: real
    assume dh: "0<=d"
    have "a * d - b * d = (a - b) * d "
      by (simp add: algebra_simps)
    hence "\<bar>a * d - b * d\<bar> = \<bar>(a - b) * d\<bar>"
      by simp
    also with dh have
      "... = \<bar>a - b\<bar> * d"
      by (simp add: abs_mult)
    finally
      have "\<bar>a * d - b * d\<bar> = \<bar>a - b\<bar> * d"
        .
    (* This sublemma is solved by ICS, file: abs_distrib_mult.ics *)
    (* It is not solved nor
       by (auto simp add: distrib_right diff_minus)(arith)
        in Isabelle  *)
  }
  with ch and divide_inverse show ?thesis
    by (auto simp add: divide_inverse)
qed

text \<open>The next three lemmas are about the existence of bounds of the
values @{term "Max (reduce f PR)"} and @{term "Min (reduce f PR)"}. These
are used in the proof of the main property.\<close>

lemma uboundmax:
assumes
  hC: "C \<subseteq> PR" and
  hCk: "np <= card C + khl"
shows
  "\<exists> i\<in>C. Max (reduce f PR) <= f i"
proof-
  from reduce_not_empty and finite_reduce
  have maxrinr: "Max (reduce f PR) \<in> reduce f PR"
    by simp
  with exist_reduce
  have "\<exists> i\<in> PR-(kmax f PR \<union> kmin f PR). f i = Max (reduce f PR)"
    by simp
  then obtain pmax where
    pmax_in_reduc: "pmax \<in> PR-(kmax f PR \<union> kmin f PR)" and
    fpmax_ismax: "f pmax = Max (reduce f PR)" ..
  hence "C \<inter> insert pmax (kmax f PR)  \<noteq> {}"
  proof-
    from kmax_prop and pmax_in_reduc
      and finite_kmax and hCk  have
      "card PR < card C + card (insert pmax (kmax f PR))"
      by simp
    moreover
    from pmax_in_reduc and kmax_prop
    have "insert pmax (kmax f PR) \<subseteq> PR" by blast
    moreover
    note hC
    ultimately
    show ?thesis
      using subsets_int[of PR C "insert pmax (kmax f PR)"]
      by simp
  qed
  hence res: "\<exists> i\<in>C. i=pmax \<or> i \<in> kmax f PR" by blast
  then obtain i where
    iinC: "i\<in>C" and altern: "i=pmax \<or> i \<in> kmax f PR" ..
  thus ?thesis
  proof(cases "i=pmax")
    case True
    with iinC fpmax_ismax show ?thesis by force
  next
    case False
    with altern maxrinr fpmax_ismax kmax_ge
    have "f pmax <= f i" by simp
    with iinC fpmax_ismax show ?thesis by auto
  qed
qed

lemma lboundmin:
assumes
  hC: "C \<subseteq> PR" and
  hCk: "np <= card C + khl"
shows
  "\<exists> i\<in>C. f i <= Min (reduce f PR)"
proof-
  from reduce_not_empty and finite_reduce
  have minrinr: "Min (reduce f PR) \<in> reduce f PR"
    by simp
  with exist_reduce
  have "\<exists> i\<in> PR-(kmax f PR \<union> kmin f PR). f i = Min (reduce f PR)"
    by simp
  then obtain pmin where
    pmin_in_reduc: "pmin \<in> PR-(kmax f PR \<union> kmin f PR)" and
    fpmin_ismin: "f pmin = Min (reduce f PR)" ..
  hence "C \<inter> insert pmin (kmin f PR)  \<noteq> {}"
  proof-
    from kmin_prop and pmin_in_reduc
      and finite_kmin and hCk  have
      "card PR < card C + card (insert pmin (kmin f PR))"
      by simp
    moreover
    from pmin_in_reduc and kmin_prop
    have "insert pmin (kmin f PR) \<subseteq> PR" by blast
    moreover
    note hC
    ultimately
    show ?thesis
      using subsets_int[of PR C "insert pmin (kmin f PR)"]
      by simp
  qed
  hence res: "\<exists> i\<in>C. i=pmin \<or> i \<in> kmin f PR" by blast
  then obtain i where
    iinC: "i\<in>C" and altern: "i=pmin \<or> i \<in> kmin f PR" ..
  thus ?thesis
  proof(cases "i=pmin")
    case True
    with iinC fpmin_ismin show ?thesis by force
  next
    case False
    with altern minrinr fpmin_ismin kmin_le
    have "f i <= f pmin" by simp
    with iinC fpmin_ismin show ?thesis by auto
  qed
qed

lemma same_bound:
assumes
  hC: "C \<subseteq> PR" and
  hCk: "np <= card C + khl" and
  hnk: "3 * khl < np"
shows
  "\<exists> i\<in>C. Min (reduce f PR) <= f i \<and> g i <= Max (reduce g PR) "
proof-
  have b1: "khl + 1 <= card (C \<inter> (PR - kmin f PR))"
  proof(rule pigeonhole)
    show "finite PR" by simp
  next
    show "C \<subseteq> PR" by fact
  next
    show "PR - kmin f PR \<subseteq> PR" by blast
  next
    show "card PR + (khl + 1) \<le> card C + card (PR - kmin f PR)"
    proof-
      from hnk and hCk have
        "np + khl < np + card C - khl" by arith
      also
      from kmin_prop
      have "... = np + card C - card (kmin f PR)"
        by auto
      also
      have "... = card C + (card PR - card (kmin f PR))"
      proof-
        from kmin_prop have
          "card (kmin f PR) <= card PR"
          by (intro card_mono, auto)
        thus ?thesis by (simp)
      qed
      also
      from kmin_prop
      have "... = card C +  card (PR - kmin f PR)"
      proof-
        from kmin_prop and finite_kmin have
          "card PR - card (kmin f PR) =  card (PR - kmin f PR)"
          by (intro card_Diff_subset[THEN sym])(auto)
        thus ?thesis by auto
      qed
      finally
      show ?thesis
        by (simp)
    qed
  qed

  have "C \<inter> (PR - kmin f PR) \<inter> (PR - kmax g PR) \<noteq> {}"
  proof(intro subsets_int)
    show "finite PR" by simp
  next
    show "C \<inter> (PR - kmin f PR) \<subseteq> PR"
      by blast
  next
    show "PR - kmax g PR \<subseteq> PR"
      by blast
  next
    show "card PR <
      card (C \<inter> (PR - kmin f PR)) + card (PR - kmax g PR)"
    proof-
      from kmax_prop and finite_kmax
      have "card (PR - kmax g PR)= card PR - card (kmax g PR) "
        by  (intro card_Diff_subset, auto)
      with kmax_prop have
        "card (PR - kmax g PR) = card PR - khl" by simp
      with b1
      show ?thesis by arith
    qed
  qed

  hence
    "\<exists> i. i \<in> C \<and> i \<in> (PR - kmin f PR) \<and> i \<in> (PR - kmax g PR)"
    by blast
  then obtain i where
    in_C: "i \<in> C" and
    not_in_kmin: "i \<in> (PR - kmin f PR)" and
    not_in_kmax: "i \<in> (PR - kmax g PR)" by blast
  have "Min (reduce f PR) <= f i"
  proof(cases "i \<in> kmax f PR")
    case True
    from reduce_not_empty and finite_reduce have
      " Min (reduce f PR) \<in> reduce f PR" by auto
    with True show ?thesis
      using kmax_ge by blast
  next
    case False
    with not_in_kmin
    have "i \<in> PR - (kmax f PR \<union> kmin f PR)"
      by blast
    with reduce_def have "f i \<in> reduce f PR"
      by auto
    with reduce_not_empty and finite_reduce
    show ?thesis by auto
  qed
  moreover
  have "g i <= Max (reduce g PR)"
  proof(cases "i \<in> kmin g PR")
    case True
    from reduce_not_empty and finite_reduce have
      " Max (reduce g PR) \<in> reduce g PR" by auto
    with True show ?thesis
      using kmin_le by blast
  next
    case False
    with not_in_kmax
    have "i \<in> PR - (kmax g PR \<union> kmin g PR)"
      by blast
    with reduce_def have "g i \<in> reduce g PR"
      by auto
    with reduce_not_empty and finite_reduce
    show ?thesis by auto
  qed
  moreover
  note in_C
  ultimately
  show ?thesis by blast
qed

subsubsection \<open>Main theorem\<close>

text \<open>The most part of this theorem can be proved with CVC-lite
using the three previous lemmas (appendix \ref{sec:bound_prec_enh}).\<close>

theorem prec_enh:
assumes
  hC: "C \<subseteq> PR" and
  hCF: "np - nF <= card C" and
  hFn: "3 * nF < np" and
  hFk: "nF = khl" and
  hbx: "\<forall> l\<in>C. \<bar>f l - g l\<bar> <= x" and
  hby1: "\<forall> l\<in>C. \<forall> m\<in>C. \<bar>f l - f m\<bar> <= y" and
  hby2: "\<forall> l\<in>C. \<forall> m\<in>C. \<bar>g l - g m\<bar> <= y" and
  hpC: "p\<in>C" and
  hqC: "q\<in>C"
shows "\<bar> cfnl p f - cfnl q g \<bar> <= y / 2 + x"
proof-
  from hCF and hFk
  have hCk: "np <= card C + khl" by arith
  from hFn and hFk
  have hnk: "3 * khl < np"  by arith
  let    ?maxf = "Max (reduce f PR)"
    and  ?minf = "Min (reduce f PR)"
    and  ?maxg = "Max (reduce g PR)"
    and  ?ming = "Min (reduce g PR)"
  from abs_distrib_div
  have "\<bar>cfnl p f - cfnl q g\<bar> =
    \<bar>?maxf + ?minf  +  - ?maxg + - ?ming\<bar> / 2"
    by (unfold cfnl_def) simp
  moreover
  have "\<bar>?maxf + ?minf  +  - ?maxg + - ?ming\<bar> <= y + 2 * x"
    \<comment> \<open>The rest of the property can be proved by CVC-lite
           (see appendix \ref{sec:bound_prec_enh})\<close>
  proof ( cases "0 <= ?maxf + ?minf  +  - ?maxg + - ?ming")
    case True
    hence
    "\<bar>?maxf + ?minf  +  - ?maxg + - ?ming\<bar> =
      ?maxf + ?minf  +  - ?maxg + - ?ming" by arith
    moreover
    from uboundmax hC hCk
    obtain mxf
      where mxfinC: "mxf\<in>C" and
            maxf: "?maxf <= f mxf" by blast
    moreover
    from lboundmin hC hCk
    obtain mng
      where mnginC: "mng\<in>C" and
            ming: "g mng <= ?ming" by blast
    moreover
    from same_bound hC hCk hnk
    obtain mxn
      where mxninC: "mxn\<in>C" and
            mxnf: "?minf  \<le> f mxn" and
            mxng: "g mxn \<le> ?maxg" by blast
    ultimately
    have
      "\<bar> ?maxf + ?minf  +  - ?maxg + - ?ming\<bar> <=
      (f mxf + - g mng) + (f mxn  +  - g mxn)" by arith
    also
    from  mxninC hbx abs_le_D1
    have
      "... <= (f mxf + - g mng) + x"
      by auto
    also
    have
      "... = (f mxf + - f mng ) + ( f mng + - g mng) + x"
      by arith
    also
    have "... <= y + ( f mng + - g mng) + x"
    proof-
      from  mxfinC mnginC hby1 abs_le_D1
      have "f mxf + - f mng <= y"
        by auto
      thus ?thesis
        by auto
    qed
    also
    from  mnginC hbx abs_le_D1
    have "... <= y + 2 * x"
      by auto
    finally
    show ?thesis .
  next
    case False
    hence
    "\<bar>?maxf + ?minf  +  - ?maxg + - ?ming\<bar> =
      ?maxg + ?ming  +  - ?maxf + - ?minf" by arith
    moreover
    from uboundmax hC hCk
    obtain mxg
      where mxginC: "mxg\<in>C" and
            maxg: "?maxg <= g mxg" by blast
    moreover
    from lboundmin hC hCk
    obtain mnf
      where mnfinC: "mnf\<in>C" and
            minf: "f mnf <= ?minf" by blast
    moreover
    from same_bound hC hCk hnk
    obtain mxn
      where mxninC: "mxn\<in>C" and
            mxnf: "?ming  \<le> g mxn" and
            mxng: "f mxn \<le> ?maxf" by blast
    ultimately
    have
      "\<bar> ?maxf + ?minf  +  - ?maxg + - ?ming\<bar> <=
      (g mxg + - f mnf) + (g mxn  +  - f mxn)" by arith
    also
    from  mxninC hbx
    have "... <= (g mxg + - f mnf) + x"
        by (auto dest!: abs_le_D2)
    also
    have
      "... = (g mxg + - g mnf ) + ( g mnf + - f mnf) + x"
      by arith
    also
    have "... <= y + ( g mnf + - f mnf) + x"
    proof-
      from  mxginC mnfinC hby2 abs_le_D1
      have "g mxg + - g mnf <= y"
        by auto
      thus ?thesis
        by auto
    qed
    also
    from  mnfinC hbx
    have "... <= y + 2 * x"
      by (auto dest!: abs_le_D2)
    finally
    show ?thesis .
  qed
  ultimately
  show ?thesis
    by simp
qed

subsection \<open>Accuracy Preservation property\<close>

text \<open>No new lemmas are needed for prove this property. The bound
has been found using the lemmas @{thm [source] uboundmax} and @{thm
[source] lboundmin}\<close>

text \<open>This theorem can be proved with ICS and CVC-lite assuming
those lemmas (see appendix \ref{sec:accur_pres}).\<close>

theorem accur_pres:
assumes
  hC: "C \<subseteq> PR" and
  hCF: "np - nF <= card C" and
  hFk: "nF = khl" and
  hby: "\<forall> l\<in>C. \<forall> m\<in>C. \<bar>f l - f m\<bar> <= y" and
  hqC: "q\<in>C"
shows "\<bar> cfnl p f - f q \<bar> <= y"
proof-
  from hCF and hFk
  have npleCk: "np <= card C + khl" by arith
  show ?thesis
  proof(cases "f q <= cfnl p f")
    case True
    from npleCk hC and  uboundmax
    have "\<exists> i\<in>C. Max (reduce f PR) <= f i"
      by auto
    then obtain pi where
      hpiC: "pi \<in> C" and
      fpiGeMax: "Max (reduce f PR) <= f pi" by blast
    from reduce_not_empty
    have "Min (reduce f PR) <= Max (reduce f PR)"
      by (auto simp add: reduce_def)
    with fpiGeMax have
      cfnlLefpi: "cfnl p f <= f pi"
      by (auto simp add: cfnl_def)
    with True have
      "\<bar> cfnl p f - f q \<bar> <= \<bar> f pi - f q \<bar>"
      by arith
    with hpiC and hqC and hby show ?thesis
      by force
  next
    case False
    from npleCk hC and lboundmin
    have "\<exists> i\<in>C. f i <= Min (reduce f PR)"
      by auto
    then obtain qi where
      hqiC: "qi \<in> C" and
      fqiLeMax: "f qi <= Min (reduce f PR)" by blast
    from reduce_not_empty
    have "Min (reduce f PR) <= Max (reduce f PR)"
      by (auto simp add: reduce_def)
    with fqiLeMax
    have "f qi <= cfnl p f"
      by (auto simp add: cfnl_def)
    with False have
      "\<bar> cfnl p f - f q \<bar> <= \<bar> f qi - f q \<bar>"
      by arith
    with hqiC and hqC and hby show ?thesis
      by force
  qed
qed

end