theory Valued_Fields
  imports  Main "~~/src/HOL/Algebra/Ring"
                "~~/src/HOL/Algebra/QuotRing"
                "~~/src/HOL/Algebra/Valued_Fields/Extended_OAG"
                "~~/src/HOL/Algebra/Subrings"
                "~~/src/HOL/Algebra/Ideal"

begin

declare [[ smt_timeout = 6000 ]]

record ('a, 'b) valued_ring =
  ring :: "'a ring" ("K\<index>")
  val_group::  "'b extended_ordered_monoid" ("\<Gamma>\<index>")
  ord :: "'a \<Rightarrow> 'b" ("\<nu>\<index>")

(*Definition of the valuation ring of a valued ring G. It is defined as the subring of "ring G"
consisting of elements of positive valuation.*)

definition
  valuation_ring :: "('a,'b, 'm) valued_ring_scheme \<Rightarrow> 'a ring" ("\<O>\<index>")
  where "valuation_ring G = \<lparr>carrier = {x.( x \<in> (carrier (ring G))
                                  \<and> \<one>\<^bsub>val_group G\<^esub> \<preceq>\<^bsub>val_group G\<^esub> (\<nu>\<^bsub>G\<^esub> x))},
                             mult = mult (ring G),
                             one = \<one>\<^bsub>(ring G)\<^esub> ,
                             zero = \<zero>\<^bsub>(ring G)\<^esub>,
                             add = add (ring G)\<rparr> "

definition
  maximal_ideal:: "('a,'b, 'm) valued_ring_scheme \<Rightarrow> 'a set" ("\<mm>\<index>")
  where "maximal_ideal G = {x. x \<in> (carrier (ring G))
                            \<and> \<one>\<^bsub>val_group G\<^esub>\<preceq>\<^bsub>val_group G\<^esub> (\<nu>\<^bsub>G\<^esub> x)
                            \<and> \<one>\<^bsub>val_group G\<^esub> \<noteq>(\<nu>\<^bsub>G\<^esub> x)}"

definition
  residue_field :: "('a,'b, 'm) valued_ring_scheme \<Rightarrow> 'a set ring" ("k\<index>")
  where "residue_field G = \<O>\<^bsub>G\<^esub> Quot (\<mm>\<^bsub>G\<^esub>)"

(*Predicate for a function from a ring to an extended OAG which obeys the ultrametric inequality*)

abbreviation
  is_ultrametric :: "[('a, 'm) ring_scheme, ('b, 'n) extended_ordered_monoid_scheme, 'a \<Rightarrow>'b ] => bool"
  where "is_ultrametric R S h \<equiv>  (\<forall> x. x \<in> carrier R \<longrightarrow> (h x) \<in> carrier S \<union> {\<infinity>\<^bsub>S\<^esub>}) \<and>
                                 ( \<forall> x y. x \<in> carrier R \<and> y \<in> carrier R
                                          \<longrightarrow> (le S (Min\<^bsub>S\<^esub>  (h x) (h y))  ( h (x\<oplus>\<^bsub>R\<^esub>y)) ))"

(*Predicate for the set of nonzero elements in a ring *)
abbreviation
  nonzero :: "('a, 'm) ring_scheme \<Rightarrow> 'a set"
  where "nonzero R \<equiv> {x. x \<in> carrier R \<and> x \<noteq> (zero R)}"

(*Predicate for a function from a ring to an extended
 OAG which is multiplicative on nonzero ring elements*)

abbreviation
  multiplicative :: "[('a, 'm) ring_scheme, ('b, 'n) extended_ordered_monoid_scheme, 'a \<Rightarrow>'b ] => bool"
  where "multiplicative R S h \<equiv> ( \<forall> x y. x \<in> nonzero R
                                        \<and> y \<in> nonzero R
                                      \<longrightarrow> h(x \<otimes>\<^bsub>R\<^esub>y) =  (h x)\<otimes>\<^bsub>S\<^esub>(h y)) "

(*Predicate for a function from a ring to an extended OAG which sends units to true group elements*)

abbreviation
  nonzero_to_group :: "[('a, 'm) ring_scheme, ('b, 'n) extended_ordered_monoid_scheme, 'a \<Rightarrow>'b ] => bool"
  where "nonzero_to_group R S h \<equiv> (\<forall> x. (x \<in> carrier R \<and> (x \<noteq> \<zero>\<^bsub>R\<^esub>)) \<longrightarrow> (h x) \<in> carrier S)"

(*Definition for the set of valuations from a fixed ring to a fixed OAG*)

definition
  valuation :: "[('a, 'm) ring_scheme, ('b, 'n) extended_ordered_monoid_scheme] => ('a => 'b) set"
  where "valuation R S =
    {h. h \<in> carrier R \<rightarrow> vals S   \<and> (is_ultrametric R S h)
                                  \<and> (multiplicative R S h)
                                  \<and> (nonzero_to_group R S h)
                                  \<and> (h \<zero>\<^bsub>R\<^esub>) = \<infinity>\<^bsub>S\<^esub>
                                  \<and> (h \<one>\<^bsub>R\<^esub>) = \<one>\<^bsub>S\<^esub> }"

lemma valuationI:
  fixes R (structure)
  fixes S (structure)
  assumes "h \<in> carrier R \<rightarrow> vals S"
  assumes " (is_ultrametric R S h)"
  assumes "(multiplicative R S h)"
  assumes "(nonzero_to_group R S h)"
  assumes " (h \<zero>\<^bsub>R\<^esub>) = \<infinity>\<^bsub>S\<^esub> "
  assumes  "(h \<one>\<^bsub>R\<^esub>) = \<one>\<^bsub>S\<^esub> "
  shows "h \<in> valuation R S"
proof-
  have A: " h \<in> carrier R \<rightarrow> vals S   \<and> (is_ultrametric R S h)
                                  \<and> (multiplicative R S h)
                                  \<and> (nonzero_to_group R S h)
                                  \<and> (h \<zero>\<^bsub>R\<^esub>) = \<infinity>\<^bsub>S\<^esub>
                                  \<and> (h \<one>\<^bsub>R\<^esub>) = \<one>\<^bsub>S\<^esub> "
    using assms(2) assms(3) assms(4) assms(5) assms(6) by blast
  then show ?thesis
    by (simp add: A valuation_def)
qed

(*Locale for a valued integral domain*)

locale valued_ring =
  fixes G (structure)
  assumes a_domain:
    "Ring.domain K"
  assumes a_val_group:
    "extended_ordered_abelian_group \<Gamma>"
  assumes a_valuation:
    "\<nu> \<in> valuation K \<Gamma>"

lemma valued_ringI:
  fixes G (structure)
  assumes a_domain:
    "Ring.domain K"
  assumes a_val_group:
    "extended_ordered_abelian_group \<Gamma>"
  assumes a_valuation:
    "\<nu> \<in> valuation K \<Gamma>"
  shows "valued_ring G"
  by (simp add: a_domain a_val_group a_valuation valued_ring_def)

fun (in ring)
int_const :: "int \<Rightarrow> 'a" ("c\<index>") where
"int_const n = Group.pow (add_monoid R) \<one>\<^bsub>R\<^esub> n"

lemma (in valued_ring) ultrametric:
    assumes "x \<in> carrier K"
    assumes "y \<in> carrier K"
    shows " (Min\<^bsub>\<Gamma>\<^esub>   (\<nu> x) (\<nu> y))\<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x\<oplus>\<^bsub>K\<^esub>y) "
proof-
  have "x \<in> carrier K \<and> y \<in> carrier K \<longrightarrow>(Min\<^bsub>\<Gamma>\<^esub>  (\<nu> x) (\<nu> y)) \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x\<oplus>\<^bsub>K\<^esub>y) "
    using a_valuation valuation_def by (simp add: valuation_def)
  from this show  "(Min\<^bsub>\<Gamma>\<^esub>  (\<nu> x) (\<nu> y))\<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x\<oplus>\<^bsub>K\<^esub>y) " using assms(1) assms(2) by blast
qed

lemma (in ring) const_one:
"c\<^bsub>1\<^esub> = \<one>\<^bsub>R\<^esub>"
  by (metis add.int_pow_1 add_pow_def int_const.elims one_closed)

lemma (in ring)
"c\<^bsub>(n + 1)\<^esub> = c\<^bsub>n\<^esub> \<oplus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>"
  by (metis add.int_pow_mult add_pow_def
      const_one int_const.simps one_closed)

lemma (in valued_ring) val_ring_subset:
  assumes "x \<in> carrier \<O>"
  shows "x \<in> carrier K"
  by (metis (no_types, lifting)
      assms mem_Collect_eq
      partial_object.select_convs(1)
      valuation_ring_def)

lemma (in valued_ring) val_range:
  assumes "x \<in> carrier K"
  shows "\<nu> x \<in> vals \<Gamma>"
  using a_valuation valuation_def by (simp add: valuation_def assms)

lemma (in valued_ring) multiplicative:
  assumes "x \<in> carrier K"
  assumes "y \<in> carrier K"
  shows "\<nu> (x \<otimes>\<^bsub>K\<^esub> y) = (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> (\<nu> y)"
proof-
  have M: "(multiplicative K \<Gamma> \<nu>)"
    using a_valuation by (simp add: valuation_def)
  from this show  "\<nu> (x  \<otimes>\<^bsub>K\<^esub> y) = (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> (\<nu> y)"
  proof (cases "(x = \<zero>\<^bsub>K\<^esub>) \<or> ( y = \<zero>\<^bsub>K\<^esub>)")
    case True
    then have "x \<otimes>\<^bsub>K\<^esub> y = \<zero>\<^bsub>K\<^esub>"
      by (simp add: a_domain assms(1) assms(2) domain.integral_iff)
    then have LHS: "\<nu> (x \<otimes>\<^bsub>K\<^esub> y) = \<infinity>\<^bsub>\<Gamma>\<^esub>"
      using a_valuation valuation_def by auto
    from True have "\<nu> x = \<infinity>\<^bsub>\<Gamma>\<^esub> \<or> \<nu> y = \<infinity>\<^bsub>\<Gamma>\<^esub>"
      using LHS \<open>x \<otimes>\<^bsub>K\<^esub> y = \<zero>\<^bsub>K\<^esub>\<close> by auto
    from this LHS val_range show "\<nu> (x \<otimes>\<^bsub>K\<^esub> y) = (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> (\<nu> y)"
      by (simp add: extended_ordered_abelian_group.add_infinityOR a_val_group assms(1) assms(2))
  next
    case False
    from this  a_valuation and valuation_def have 0: "x \<in> nonzero K"
      using assms(1) by blast
    from False  a_valuation and valuation_def have 1: "y \<in> nonzero K"
      using assms(2) by blast
    from 0 and 1 and M show "\<nu>(x \<otimes>\<^bsub>K\<^esub> y) =  (\<nu> x)\<otimes>\<^bsub>\<Gamma>\<^esub>(\<nu> y)" by blast
  qed
qed

lemma (in valued_ring) inv_simpR:
  assumes "x \<in> Units K"
  shows "inv\<^bsub>K\<^esub> x \<otimes>\<^bsub>K\<^esub>  x = \<one>\<^bsub>K\<^esub>"
  by (meson assms Ring.ring_def a_domain cring.axioms(1)
      domain_def monoid.Units_l_inv)

lemma (in valued_ring) inv_simpL:
  assumes "x \<in> Units K"
  shows "x \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>"
  using inv_simpR a_domain Units_def assms
        comm_monoid.comm_inv_char cring_def
        domain.axioms(1) by fastforce

lemma (in valued_ring) nonzero_val:
  assumes "(x \<in> carrier K \<and> (x \<noteq> \<zero>\<^bsub>K\<^esub>))"
  shows "(\<nu> x) \<in> carrier \<Gamma>"
proof-
  have "(x \<in> carrier K \<and> (x \<noteq> \<zero>\<^bsub>K\<^esub>)) \<longrightarrow> (\<nu> x) \<in> carrier \<Gamma>"
    using a_valuation by (simp add: valuation_def)
  from this and assms(1) show "(\<nu> x) \<in> carrier \<Gamma>" by auto
qed

lemma (in valued_ring) nonzero_val2:
  assumes "x \<in> Units K"
  shows "(\<nu> x) \<in> carrier \<Gamma>"
  using Ring.ring_def a_domain cring_def domain.axioms(1)
        domain.integral_iff domain.one_not_zero monoid.Units_inv_closed
        monoid.Units_r_inv valued_ring.nonzero_val valued_ring_axioms
        by (metis assms monoid.Units_closed)

lemma (in valued_ring) val_zero:
  "\<nu> \<zero>\<^bsub>K\<^esub> = \<infinity>\<^bsub>\<Gamma>\<^esub>"
  using a_valuation by (simp add: valuation_def)

lemma (in valued_ring) val_one:
  "\<nu> \<one>\<^bsub>K\<^esub> = \<one>\<^bsub>\<Gamma>\<^esub>"
  using a_valuation by (simp add: valuation_def)

lemma (in valued_ring) val_neg_1:
  shows  "\<nu> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>) = \<one>\<^bsub>\<Gamma>\<^esub>"
proof-
  have C0: "(\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>) \<otimes>\<^bsub>K\<^esub> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>) = \<one>\<^bsub>K\<^esub>"
    by (simp add: a_domain cring.cring_simprules(12)
      cring.cring_simprules(21) cring.cring_simprules(28)
      cring.cring_simprules(3) cring.cring_simprules(6)
      domain.axioms(1))
  then have C1: "\<nu> (\<one>\<^bsub>K\<^esub>) = \<nu> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>) \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>)"
    using multiplicative a_domain cring.cring_simprules(3)
          cring.cring_simprules(6) domain.axioms(1) by force
  from ordered_abelian_group.no_idempotents1 show " \<nu> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>)  =  \<one>\<^bsub>\<Gamma>\<^esub>"
    by (metis C0 C1 a_domain a_val_group cring.cring_simprules(3)
      cring.cring_simprules(6) domain.axioms(1) domain.integral_iff
      extended_ordered_abelian_group.axioms(1) val_one
      valued_ring.nonzero_val valued_ring_axioms)
qed

lemma (in valued_ring) val_add_inv:
  assumes "x \<in> carrier K"
  shows  "\<nu> (\<ominus>\<^bsub>K\<^esub> x) = \<nu> x "
proof-
  have C0: "\<ominus>\<^bsub>K\<^esub> x = x \<otimes>\<^bsub>K\<^esub> (\<ominus>\<^bsub>K\<^esub> \<one>\<^bsub>K\<^esub>)"
  using Ring.ring_def a_domain assms cring_def domain.axioms(1) ring.r_minus by fastforce
  then show  "\<nu> (\<ominus>\<^bsub>K\<^esub> x) = \<nu> x "
    by (metis multiplicative val_neg_1 Ring.ring_def a_domain  assms
        cring.cring_simprules(3)
        cring_def domain.axioms(1)
        monoid.one_closed monoid.r_one
        val_one)
qed

lemma (in valued_ring) val_sum:
  assumes "x \<in> carrier K"
  assumes "y \<in> carrier K"
  shows "\<nu> (x \<oplus>\<^bsub>K\<^esub> y) \<in> vals \<Gamma>"
  by (meson a_domain assms(1) assms(2)
      cring.cring_simprules(1) domain_def val_range)

lemma (in valued_ring) one_is_val:
  "\<one>\<^bsub>\<Gamma>\<^esub> \<in> vals \<Gamma>"
  by (metis a_domain cring.cring_simprules(6)
      domain.axioms(1) val_one
      valued_ring.val_range valued_ring_axioms)

lemma (in valued_ring) one_in_group:
  "\<one>\<^bsub>\<Gamma>\<^esub> \<in> carrier \<Gamma>"
  by (simp add: a_val_group
      extended_ordered_abelian_group.axioms(1)
      ordered_abelian_group.one_in)

lemma (in valued_ring) in_val_ring:
  assumes "x \<in> carrier K"
  assumes "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
  shows "x \<in> carrier \<O>"
  using assms(1) assms(2) val_zero by (simp add: valuation_ring_def)

lemma (in valued_ring) in_val_ring_conv:
  assumes "x \<in> carrier K"
  assumes "x \<in> carrier \<O>"
  shows "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
  by (metis (no_types, lifting) assms(2)
      mem_Collect_eq partial_object.select_convs(1)
      valuation_ring_def)

locale valued_field = valued_ring +
  assumes a_field:
    "Ring.field (ring G)"
  assumes val_surj:
    "surj \<nu>"

lemma valued_fieldI:
  fixes G (structure)
  assumes "valued_ring G"
  assumes a_field:
    "Ring.field (ring G)"
  assumes val_surj:
    "surj \<nu>"
  shows "valued_field G"
  by (simp add: a_field assms(1) val_surj valued_field.intro valued_field_axioms_def)

lemma (in valued_ring) prod_inequality:
  assumes "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
  assumes "x \<in> carrier K"
  assumes "a \<in> carrier K"
  shows   "\<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
proof-
  have C1:"\<nu> x \<in> vals \<Gamma>"
    using assms(2) val_range by auto
  have C2: "\<nu> a \<in> vals \<Gamma>"
    using assms(3) val_range by auto
  have "\<one>\<^bsub>\<Gamma>\<^esub> \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x  \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> a"
    using assms(1) C1 C2 one_is_val
    by (simp add: extended_ordered_abelian_group.E_le_resp_mult a_val_group)
  from this and multiplicative show  "\<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
    by (metis a_domain assms(2) assms(3) cring.cring_simprules(12)
        cring.cring_simprules(6) domain.axioms(1) val_one)
qed

lemma (in valued_ring) prod_chain:
  assumes "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
  assumes "x \<in> carrier K"
  assumes "a \<in> carrier K"
  assumes "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> a"
  assumes "\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> a"
  shows  "\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
proof
  assume 0: "\<one>\<^bsub>\<Gamma>\<^esub> = \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
  show False
  proof-
    from prod_inequality have "\<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
      using assms(1) assms(2) assms(3) by blast
    from this and 0 have  "\<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<one>\<^bsub>\<Gamma>\<^esub>"  by simp
    from this and assms(4) have "\<one>\<^bsub>\<Gamma>\<^esub> = \<nu> a"
      by (meson a_val_group assms(3)
        extended_ordered_abelian_group.chain
        one_is_val valued_ring.val_range valued_ring_axioms)
    from this and assms(5) show False by auto
qed
qed

lemma (in valued_ring) val_of_inverse:
  assumes D: "x \<in> carrier K"
  assumes U: "x \<in> Units K"
  shows "inv\<^bsub>\<Gamma>\<^esub> (\<nu> x) = \<nu> (inv\<^bsub>K\<^esub> x)"
proof-
  from D and U have Q: "inv\<^bsub>K\<^esub> x \<in> carrier K"
    by (meson Ring.ring_def a_domain cring_def
        domain_def monoid.Units_inv_closed)
  have P: "\<nu> (x \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x) = (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> (inv\<^bsub>K\<^esub> x)"
    using Q D multiplicative by blast
  have "\<exists> y \<in> carrier K. x \<otimes>\<^bsub>K\<^esub> y = \<one>\<^bsub>K\<^esub> "
    using monoid.Units_r_inv_ex U Ring.ring_def
          a_domain cring_def domain.axioms(1) by metis
  from this have "x \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>"
    using U inv_simpL by blast
  from this and P have "\<nu> \<one>\<^bsub>K\<^esub> = (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> (\<nu> (m_inv K x))"
    by simp
  from this have  "\<exists> y \<in> carrier \<Gamma>. (\<nu> x) \<otimes>\<^bsub>\<Gamma>\<^esub> y = \<one>\<^bsub>\<Gamma>\<^esub> "
    by (metis D Q \<open>x \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>\<close> a_domain
        domain.integral_iff domain.one_not_zero val_one
        valued_ring.nonzero_val valued_ring_axioms)
  from this show  "m_inv \<Gamma> (\<nu> x) =\<nu> (m_inv K x)"
    by (metis D Q \<open>x \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>\<close> a_domain
        a_val_group cring.cring_simprules(14) domain.axioms(1)
        domain.integral_iff domain.one_not_zero extended_ordered_abelian_group.axioms(1)
        monoid.inv_char multiplicative ordered_abelian_group_def ordered_monoid_def
        val_one valued_ring.nonzero_val valued_ring_axioms)
qed

lemma (in valued_ring) val_inverse_or:
  assumes D: "x \<in> carrier K"
  assumes U: "x \<in> Units K"
  shows " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> (\<nu> (m_inv K x)) \<or>  \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
proof-
  from D and U nonzero_val have 0: "\<nu> x \<in> carrier \<Gamma>"
    by (simp add: nonzero_val2)
  from this and val_of_inverse have 1:" \<nu> (m_inv K x) \<in> carrier \<Gamma>"
    by (meson Ring.ring_def U a_domain
        cring_def domain.axioms(1) monoid.Units_inv_Units
        nonzero_val2)
  then show " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (m_inv K x) \<or>  \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
    by (metis 0 1  ordered_abelian_group.inv_or
        Ring.ring_def U a_domain a_val_group cring_def
        domain.axioms(1) extended_ordered_abelian_group.axioms(1)
        monoid.Units_inv_Units monoid.Units_inv_closed
        monoid.Units_inv_inv ordered_abelian_group.inv_1 val_of_inverse)
qed

lemma (in valued_field) nonzero_val_conv:
  assumes  "(\<nu> x) \<in> carrier \<Gamma>"
  assumes "x \<in> carrier K"
  shows "x \<in> Units K"  (**)
proof-
  from assms have "\<nu> x \<noteq> \<infinity>\<^bsub>\<Gamma>\<^esub>"
    using a_val_group extended_ordered_abelian_group.infinity_distinct by force
  from this  assms val_zero have "x \<noteq> \<zero>\<^bsub>K\<^esub>"
    by blast
  from this show "x \<in> Units K" using a_field assms field.field_Units by blast
qed

lemma (in valued_field) val_ring_units:
  assumes "x \<in> carrier \<O>"
  assumes "\<nu> x = \<one>\<^bsub>\<Gamma>\<^esub>"
  shows "x \<in> Units \<O>"
proof-
  have car: "x \<in> carrier K"
    by (simp add: assms(1) val_ring_subset)
  then have C1: "x \<in> Units K"
    using assms(2) one_is_val a_field
          field.field_Units nonzero_val_conv
    by (simp add: one_in_group)
  then  have "inv\<^bsub>\<Gamma>\<^esub> \<nu> x =\<nu> (inv\<^bsub>K\<^esub> x)"
    using car val_of_inverse assms(1) by blast
  from this and assms(2) have " \<one>\<^bsub>\<Gamma>\<^esub> =\<nu> (inv\<^bsub>K\<^esub> x)"
    using Ring.ring_def a_domain cring.cring_simprules(6)
      cring_def domain.axioms(1) monoid.Units_one_closed
      monoid.inv_one val_of_inverse val_one by fastforce
  from this have C2: " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (inv\<^bsub>K\<^esub>x)"
    using C1 assms(2) car val_inverse_or by force
  have "x \<noteq> \<zero>\<^bsub>K\<^esub>"
    using C1 a_val_group assms(2) extended_ordered_abelian_group.infinity_distinct
      one_in_group val_zero by force
  from this car a_field C1 have "inv\<^bsub>K\<^esub>x \<in> carrier K"
  proof -
    have "(x \<in> carrier K \<and> (\<exists>a. a \<in> carrier K \<and> a \<otimes>\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub> \<and> x \<otimes>\<^bsub>K\<^esub> a = \<one>\<^bsub>K\<^esub>))
           \<and> Group.comm_monoid K"
    using C1 Units_def a_domain cring_def domain.axioms(1) by fastforce
  then show ?thesis
    by (metis (no_types) comm_monoid.comm_inv_char)
  qed
  from this have C3:"inv\<^bsub>K\<^esub>x \<in> carrier \<O>"
    by (simp add: \<open>\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (inv\<^bsub>K\<^esub> x)\<close> in_val_ring)
  from m_inv_def C1 have C4: "inv\<^bsub>K\<^esub>x \<otimes>\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>"
    using Ring.ring_def a_domain cring_def domain_def monoid.Units_l_inv by fastforce
  from this and C3 have "(inv\<^bsub>K\<^esub> x) \<in> carrier \<O>
                        \<and> inv\<^bsub>K\<^esub>x \<otimes>\<^bsub>K\<^esub> x = \<one>\<^bsub>K\<^esub>
                        \<and> (m_inv K x) \<otimes>\<^bsub>K\<^esub>  x = \<one>\<^bsub>K\<^esub>"
    by blast
  from C1 and C3 have "inv\<^bsub>K\<^esub>x \<in> carrier \<O>
                     \<and> inv\<^bsub>K\<^esub>x \<otimes>\<^bsub>\<O>\<^esub> x = \<one>\<^bsub>\<O>\<^esub>"
    by (simp add: C4 valuation_ring_def)
  from this have "\<exists> y \<in> carrier (valuation_ring G).
                  y \<otimes>\<^bsub>(valuation_ring G)\<^esub> x = \<one>\<^bsub>(valuation_ring G)\<^esub>
                \<and> x \<otimes>\<^bsub>(valuation_ring G)\<^esub>  y = \<one>\<^bsub>(valuation_ring G)\<^esub>"
    by (metis (no_types, lifting) \<open>inv\<^bsub>K\<^esub> x \<in> carrier K\<close>
        a_domain car cring.cring_simprules(14)
        domain.axioms(1) monoid.select_convs(1)
        valuation_ring_def)
  from this and Units_def show "x \<in> Units (valuation_ring G)"
    by (simp add: Units_def assms(1))
qed

lemma (in valued_ring) val_ring_minus0:
" x \<in> carrier \<O> \<Longrightarrow> (\<ominus>\<^bsub>K\<^esub> x) \<in> carrier \<O>"
proof-
 assume "x \<in> carrier (valuation_ring G)"
 then have "\<nu> (\<ominus>\<^bsub>K\<^esub> x) = \<nu> x "
   by (simp add: val_ring_subset
      valued_ring.val_add_inv valued_ring_axioms)
 from this show "(\<ominus>\<^bsub>K\<^esub> x) \<in> carrier (valuation_ring G)"
    by (simp add: \<open>x \<in> carrier \<O>\<close> a_domain cring.cring_simprules(3)
        domain.axioms(1) in_val_ring valued_ring.in_val_ring_conv
        valued_ring.val_ring_subset valued_ring_axioms)
qed

lemma (in valued_ring) val_ring_subring:
  "subring (carrier \<O>) (K)"
proof-
  have C0: "carrier \<O> \<subseteq> carrier K"
    by (simp add: subsetI val_ring_subset)
  have T: "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<one>\<^bsub>\<Gamma>\<^esub>"
    using one_is_val
    by(simp add: extended_ordered_abelian_group.refl a_val_group)
  have "\<one>\<^bsub>K\<^esub> \<in> carrier K"
    using valuation_ring_def val_one a_domain
          cring.cring_simprules(6) domain.axioms(1)
          by blast
  then have C1: "\<one>\<^bsub>K\<^esub> \<in> carrier \<O>" using T val_one
    by (simp add: valued_ring.in_val_ring valued_ring_axioms)
  have C2: "\<And>x. x \<in> carrier \<O> \<Longrightarrow> \<ominus>\<^bsub>K\<^esub> x \<in> carrier \<O>"
    proof-
    fix x
    show "x \<in> carrier \<O> \<Longrightarrow> \<ominus>\<^bsub>K\<^esub> x \<in> carrier \<O>"
    proof-
      assume A: "x \<in> carrier \<O>"
      then have "\<nu> (\<ominus>\<^bsub>K\<^esub> x) = \<nu> x"
        by (simp add: val_ring_subset valued_ring.val_add_inv valued_ring_axioms)
      from this show "\<ominus>\<^bsub>K\<^esub> x \<in> carrier \<O>"
        by (simp add: A val_ring_minus0)
     qed
    qed
  have C3: "\<And>x y.\<lbrakk>x \<in> carrier \<O>; y \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<oplus>\<^bsub>K\<^esub> y \<in> carrier \<O>"
  proof-
    fix x y
    show "\<lbrakk>x \<in> carrier \<O>; y \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<oplus>\<^bsub>K\<^esub> y \<in> carrier \<O>"
    proof-
      assume X:"x \<in> carrier \<O>"
      assume Y:"y \<in> carrier \<O>"
      show " x \<oplus>\<^bsub>K\<^esub> y \<in> carrier \<O>"
      proof-
        from X have vX: " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
          using \<open>carrier \<O> \<subseteq> carrier K\<close> in_val_ring_conv by blast
        from Y have vY: " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> y"
          using \<open>carrier \<O> \<subseteq> carrier K\<close> in_val_ring_conv by blast
        have 0: "\<nu> x \<in> vals \<Gamma>"
          using X by (meson C0 subsetCE val_range)
        have 1: "\<nu> y \<in> vals \<Gamma>"
          using Y by (meson C0 subsetCE val_range)
        have 2: "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> Min\<^bsub>\<Gamma>\<^esub>  (\<nu> x) (\<nu> y)"
            by (simp add: vX vY)
        have 3: "Min\<^bsub>\<Gamma>\<^esub> (\<nu> x) (\<nu> y)\<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<oplus>\<^bsub>K\<^esub> y)"
          by (meson C0 X Y rev_subsetD ultrametric)
        have 4: "\<nu> (x \<otimes>\<^bsub>add_monoid K\<^esub> y) \<in> vals \<Gamma>"
          using X Y val_ring_subset val_sum by auto
        from 0 1 have 5:"Min\<^bsub>\<Gamma>\<^esub> (\<nu> x) (\<nu> y)\<in> carrier \<Gamma> \<union> {\<infinity>\<^bsub>\<Gamma>\<^esub>}"  by simp
        have 6: "\<one>\<^bsub>\<Gamma>\<^esub> \<in> vals \<Gamma>"
          using one_is_val by auto
        from 5 have 7: "Min\<^bsub>\<Gamma>\<^esub> (\<nu> x) (\<nu> y) \<in> carrier Order\<^bsub>\<Gamma>\<^esub>" by auto
        from 4 have 8: "\<nu> (x \<oplus>\<^bsub>K\<^esub> y) \<in> carrier Order\<^bsub>\<Gamma>\<^esub>" by auto
        have 9: "\<one>\<^bsub>\<Gamma>\<^esub> \<in> carrier Order\<^bsub>\<Gamma>\<^esub>" using "6" by auto
        have 10: "weak_partial_order Order\<^bsub>\<Gamma>\<^esub>"
          using a_val_group extended_ordered_abelian_group.EOAG_is_pOrdered
                partial_order.axioms(1) by blast
        have 11: "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> (Min\<^bsub>\<Gamma>\<^esub> (\<nu> x) (\<nu> y))"
          by (simp add: "2")
        have 12 :"Min\<^bsub>\<Gamma>\<^esub> (\<nu> x) (\<nu> y) \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<oplus>\<^bsub>K\<^esub> y)"
          using "3" by auto
        have "gorder.le Order\<^bsub>\<Gamma>\<^esub> = le \<Gamma>" by auto
        then have " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>add_monoid K\<^esub> y)"
          using 10 11 12 9 7 8 weak_partial_order.le_trans
          by (smt monoid.select_convs(1))
        then show  " x \<oplus>\<^bsub>K\<^esub> y \<in> carrier \<O>"
          by (simp add: X Y a_domain cring.cring_simprules(1)
              domain.axioms(1) val_ring_subset
              valued_ring.in_val_ring valued_ring_axioms)
      qed
    qed
  qed

  have C4: "\<And>x y. \<lbrakk>x \<in> carrier \<O>; y \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>K\<^esub> y \<in> carrier \<O>"
  proof- fix x y
    show " \<lbrakk>x \<in> carrier \<O>; y \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>K\<^esub> y \<in> carrier \<O>"
    proof-
      assume A:"x \<in> carrier \<O>"
      assume B:"y \<in> carrier \<O>"
      show "x \<otimes>\<^bsub>K\<^esub> y \<in> carrier \<O>"
      proof-
        from A have  " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
          by (simp add: valuation_ring_def)
        from B have  " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> y"
         by (simp add: valuation_ring_def)
        from A have C: "\<nu> x \<in> vals \<Gamma>"
          by (meson val_range valued_ring.val_ring_subset valued_ring_axioms)
        have D: "\<nu> y \<in> vals \<Gamma>"
          by (meson B valued_ring.val_range valued_ring.val_ring_subset valued_ring_axioms)
        then  have G: "\<one>\<^bsub>\<Gamma>\<^esub>  \<otimes>\<^bsub>\<Gamma>\<^esub> \<one>\<^bsub>\<Gamma>\<^esub>  \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> y"
          using C D extended_ordered_abelian_group.E_le_resp_mult2
          by (metis \<open>\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x\<close> \<open>\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> y\<close> a_val_group one_is_val)
        from this have " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x \<otimes>\<^bsub>\<Gamma>\<^esub> \<nu> y"
          using \<open>\<one>\<^bsub>K\<^esub> \<in> carrier K\<close> a_domain cring.cring_simprules(12)
                domain.axioms(1) val_one valued_ring.multiplicative
                valued_ring_axioms by force
        from this and multiplicative have " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>K\<^esub> y )"
          using A B val_ring_subset by auto
        from this show "x \<otimes>\<^bsub>K\<^esub> y \<in> carrier \<O>"
          by (simp add: A B a_domain cring.cring_simprules(5)
                domain.axioms(1) val_ring_subset valued_ring.in_val_ring valued_ring_axioms)
      qed
    qed
  qed
  have C: "Ring.ring K" by (simp add: a_domain cring.axioms(1) domain.axioms(1))
  from C C0 C1 C2 C3 C4 show "subring (carrier \<O>) (K)"
    by (simp add: ring.subringI)
qed

lemma (in valued_ring) val_ring_subcring:
  "subcring (carrier (valuation_ring G)) (ring G)"
    by (simp add: a_domain cring.subcringI' domain.axioms(1) val_ring_subring)

lemma (in valued_ring) val_ring_domain:
  "Ring.domain (valuation_ring G)"
proof-
  have 0:"domain (ring G)" by (simp add: a_domain)
  have 1:"(valuation_ring G) =  ((ring G)\<lparr>carrier := carrier (valuation_ring G)\<rparr>)"
    by (simp add: valuation_ring_def)
  from 0 1 val_ring_subcring domain.subring_is_domain show "Ring.domain (valuation_ring G)"
  using val_ring_subring by fastforce
qed

lemma (in valued_ring) val_ring_minus1:
  assumes "x \<in> carrier \<O>"
  assumes "y \<in> carrier \<O>"
  assumes "y \<oplus>\<^bsub>\<O>\<^esub> x = \<zero>\<^bsub>\<O>\<^esub>"
  shows "y =  \<ominus>\<^bsub>\<O>\<^esub> x"
proof-
  have "comm_group (add_monoid K)"
    using Ring.ring_def a_domain abelian_group.a_comm_group cring_def domain.axioms(1) by blast
  from val_ring_domain have 0:"comm_group (add_monoid \<O>)"
    using Ring.ring_def abelian_group.a_comm_group
          cring_def domain.axioms(1) by blast
  have 1:  "x \<in> carrier (add_monoid \<O>)"
    by (simp add: assms(1))
  have 2:  "y \<in> carrier (add_monoid \<O>)"
    by (simp add: assms(2))
  show  "y = \<ominus>\<^bsub>\<O>\<^esub> x"
    using 0 1 2 assms(3) abelian_group.minus_equality comm_group_abelian_groupI by fastforce
qed

lemma (in valued_ring) val_ring_minus2:
"x \<in> carrier \<O>\<Longrightarrow> \<ominus>\<^bsub>K\<^esub> x =  \<ominus>\<^bsub>\<O>\<^esub> x"
proof-
  assume X: " x \<in> carrier \<O>"
  show "\<ominus>\<^bsub>K\<^esub> x =  \<ominus>\<^bsub>\<O>\<^esub> x"
  proof-
    from X have P:"\<ominus>\<^bsub>K\<^esub> x \<in> carrier \<O>" using val_ring_minus0 by auto
    from this have "\<ominus>\<^bsub>K\<^esub> x \<oplus>\<^bsub>\<O>\<^esub> x = \<zero>\<^bsub>\<O>\<^esub>"
    by (metis (no_types, lifting)
        X a_domain cring.cring_simprules(9)
        domain.axioms(1) ring.simps(1)
        ring_record_simps(12) valuation_ring_def
        valued_ring.val_ring_subset valued_ring_axioms)
    from this and P show "\<ominus>\<^bsub>K\<^esub> x =  \<ominus>\<^bsub>\<O>\<^esub> x"
      using X val_ring_minus1 by blast
 qed
qed

lemma (in valued_ring) maximal_ideal_in_val_ring:
  "\<mm> \<subseteq> carrier \<O>"
proof
  fix x
  show "x \<in> \<mm> \<Longrightarrow> x \<in> carrier \<O>"
  by (simp add: maximal_ideal_def valued_ring.in_val_ring valued_ring_axioms)
qed

lemma (in valued_ring) maximal_ideal_is_ideal:
  "Ideal.ideal (maximal_ideal G) (valuation_ring G)"
proof-
  have I1: "subgroup \<mm> (add_monoid \<O>)"
  proof
    show "\<mm> \<subseteq> carrier (add_monoid \<O>)"
      using maximal_ideal_def valued_ring.in_val_ring valued_ring_axioms by fastforce
    show "\<one>\<^bsub>add_monoid \<O>\<^esub> \<in> \<mm>"
    proof-
      have "\<one>\<^bsub>add_monoid (valuation_ring G)\<^esub> = \<zero>\<^bsub>(valuation_ring G)\<^esub>"  by simp
      from this have "\<one>\<^bsub>add_monoid (valuation_ring G)\<^esub> = \<zero>\<^bsub>K\<^esub>"
        by (simp add: valuation_ring_def)
      from this and val_zero have "\<nu> (\<one>\<^bsub>add_monoid (valuation_ring G)\<^esub>) = \<infinity>\<^bsub>\<Gamma>\<^esub>" by simp
      from group.Units have "\<one>\<^bsub>\<Gamma>\<^esub> \<in> carrier \<Gamma>"
        by (simp add: a_val_group
            extended_ordered_abelian_group.axioms(1) ordered_abelian_group.one_in)
      from this  have  "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<infinity>\<^bsub>\<Gamma>\<^esub> "
        by (simp add: extended_ordered_abelian_group.infinity_max1 a_val_group)
      from this show "\<one>\<^bsub>add_monoid (valuation_ring G)\<^esub> \<in> maximal_ideal G"
        using \<open>\<nu> \<one>\<^bsub>add_monoid (valuation_ring G)\<^esub> = \<infinity>\<^bsub>\<Gamma>\<^esub>\<close> \<open>\<one>\<^bsub>\<Gamma>\<^esub> \<in> carrier \<Gamma>\<close>
          \<open>\<one>\<^bsub>add_monoid (valuation_ring G)\<^esub> = \<zero>\<^bsub>K\<^esub>\<close> a_val_group
          extended_ordered_abelian_group.infinity_max2 maximal_ideal_def
          subringE(1) subringE(2) val_ring_subring by fastforce
    qed
    show "\<And>x y. \<lbrakk>x \<in> \<mm>; y \<in> \<mm>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>add_monoid \<O>\<^esub> y \<in> \<mm>"
      proof-
        fix x y
        show " \<lbrakk>x \<in> \<mm>; y \<in> \<mm>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>add_monoid \<O>\<^esub> y \<in> \<mm>"
        proof-
          assume A: "x \<in> \<mm>"
          assume B: "y \<in> \<mm>"
          show "x \<otimes>\<^bsub>add_monoid \<O>\<^esub> y \<in> \<mm> "
          proof-
            from A have A0:"\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x" by (simp add: maximal_ideal_def)
            from B have B0:"\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> y" by (simp add: maximal_ideal_def)
            from A have A1:"\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> x" by (simp add: maximal_ideal_def)
            from B have B1:"\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> y" by (simp add: maximal_ideal_def)
            from A have A2:"x \<in> carrier K" by (simp add: maximal_ideal_def)
            from B have B2:"y \<in> carrier K" by (simp add: maximal_ideal_def)
            have MinC: " Extended_OAG.Min \<Gamma> (\<nu> x) (\<nu> y) \<in> carrier \<Gamma> \<union> {\<infinity>\<^bsub>\<Gamma>\<^esub>}"
              using A2 B2 nonzero_val val_zero by auto
            have SumC: "\<nu> (x \<oplus>\<^bsub>K\<^esub> y) \<in> carrier \<Gamma> \<union> {\<infinity>\<^bsub>\<Gamma>\<^esub>}"
              using A2 B2 val_sum by auto
            have OneC: " \<one>\<^bsub>\<Gamma>\<^esub> \<in> carrier \<Gamma> \<union> {\<infinity>\<^bsub>\<Gamma>\<^esub>}"
              using ordered_abelian_group.one_in
              by (simp add: ordered_abelian_group.one_in
                  a_val_group extended_ordered_abelian_group.axioms(1))
            have P: "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> Extended_OAG.Min \<Gamma>  (\<nu> x) (\<nu> y)"  by (simp add: A0 B0)
            from this and ultrametric have Q:"Extended_OAG.Min \<Gamma> (\<nu> x) (\<nu> y) \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<oplus>\<^bsub>K\<^esub> y)"
              using A2 B2 by blast
            have R: "\<one>\<^bsub>\<Gamma>\<^esub> \<noteq>Extended_OAG.Min \<Gamma> (\<nu> x) (\<nu> y)"
              using ultrametric A1 B1 extended_ordered_abelian_group.EOAG_is_pOrdered by simp
            have X: "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<oplus>\<^bsub>K\<^esub> y)"
              using P Q extended_ordered_abelian_group.EOAG_is_pOrdered weak_partial_order.le_trans
              by (simp add: A0 A2 B0 B2 a_domain cring.cring_simprules(1) domain.axioms(1)
                  subringE(7) val_ring_subring valued_ring.in_val_ring
                  valued_ring.in_val_ring_conv valued_ring_axioms)
            from this have " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>add_monoid (valuation_ring G)\<^esub> y)"
                by (simp add: valuation_ring_def)
              have  "\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> (x \<oplus>\<^bsub>K\<^esub> y)"
                using  OneC MinC SumC  P Q R   extended_ordered_abelian_group.chain
                by (smt a_val_group)
            from this and X show "x \<otimes>\<^bsub>add_monoid (valuation_ring G)\<^esub> y \<in> maximal_ideal G "
              by (simp add: A2 B2 a_domain cring.cring_simprules(1)
                  domain.axioms(1) maximal_ideal_def valuation_ring_def)
          qed
        qed
      qed
    show "\<And>x. x \<in> \<mm> \<Longrightarrow> inv\<^bsub>add_monoid \<O>\<^esub> x \<in> \<mm>"
    proof-
      fix x
      show " x \<in> \<mm> \<Longrightarrow> inv\<^bsub>add_monoid \<O>\<^esub> x \<in> \<mm>"
      proof-
        assume A: " x \<in> \<mm>"
        show "inv\<^bsub>add_monoid \<O>\<^esub> x \<in> \<mm>"
        proof-
          from A have Q0: "\<nu> (\<ominus>\<^bsub>K\<^esub> x) = \<nu> x"
            using maximal_ideal_def valued_ring.val_add_inv valued_ring_axioms by fastforce
          from val_ring_subcring A have "\<ominus>\<^bsub>\<O>\<^esub> x = \<ominus>\<^bsub>K\<^esub> x"
            by (metis  maximal_ideal_in_val_ring subset_iff val_ring_minus2)
          from this and valuation_ring_def have P:"\<nu> (\<ominus>\<^bsub>\<O>\<^esub> x) = \<nu> x"
            using Q0 by auto
          from this have Q1: " \<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub>\<nu> (inv\<^bsub>add_monoid (valuation_ring G)\<^esub> x)"
            using A maximal_ideal_def by (simp add: maximal_ideal_def a_inv_def)
          from P have Q2: " \<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> (inv\<^bsub>add_monoid (valuation_ring G)\<^esub> x)"
            using A by (simp add: maximal_ideal_def a_inv_def)
          have Q3: "inv\<^bsub>add_monoid (valuation_ring G)\<^esub> x \<in> carrier K"
            by (metis (no_types, lifting) A \<open>\<ominus>\<^bsub>\<O>\<^esub> x = \<ominus>\<^bsub>K\<^esub> x\<close> a_domain a_inv_def
                cring.cring_simprules(3) domain.axioms(1)
                maximal_ideal_def mem_Collect_eq partial_object_ext_def)
          show "inv\<^bsub>add_monoid (valuation_ring G)\<^esub> x \<in> maximal_ideal G"
            using Q1 Q2 Q3 maximal_ideal_def  by (simp add: maximal_ideal_def)
        qed
      qed
    qed
  qed
  have I2:"\<And>a x. \<lbrakk>a \<in> \<mm>; x \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>\<O>\<^esub> a \<in> \<mm>"
  proof-
    fix a x
    show "\<lbrakk>a \<in> \<mm> ; x \<in> carrier \<O>\<rbrakk> \<Longrightarrow> x \<otimes>\<^bsub>\<O>\<^esub> a \<in> \<mm>"
    proof-
      assume 0: "a \<in> \<mm>"
      assume 1: "x \<in> carrier \<O>"
      show "x \<otimes>\<^bsub>\<O>\<^esub> a \<in> \<mm>"
      proof-
        from 1 have C1:"\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x" by (simp add: valuation_ring_def)
        from 0 have C2:"\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> a" by (simp add: maximal_ideal_def)
        from 0 have C3:"\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> a" by (simp add: maximal_ideal_def)
        from C1 C2 C3 0 1 have "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>valuation_ring G\<^esub> a)"
          by (meson cring.cring_simprules(5) domain.axioms(1)
              maximal_ideal_in_val_ring subringE(1) subsetCE val_ring_domain
              val_ring_subring valued_ring.in_val_ring_conv valued_ring_axioms)
        from 1 have C4: " \<nu> x \<in> vals \<Gamma>"
          by (metis UnI1 UnI2 singletonI subringE(1) subsetCE val_ring_subring
              val_zero valued_ring.nonzero_val valued_ring_axioms)
        from 0 have C5: " \<nu> a \<in> vals \<Gamma>"
          by (meson maximal_ideal_in_val_ring subringE(1) subsetCE
              val_ring_subring valued_ring.val_range valued_ring_axioms)
        from C1 C2 C3 0  1 have C6: "\<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>K\<^esub> a)"
          by (simp add: maximal_ideal_def prod_inequality valuation_ring_def)
        have "\<one>\<^bsub>\<Gamma>\<^esub> \<noteq> \<nu> (x \<otimes>\<^bsub>valuation_ring G\<^esub> a)"
        proof -
          have "\<not> \<nu> a \<preceq>\<^bsub>\<Gamma>\<^esub> \<one>\<^bsub>\<Gamma>\<^esub>"
            by (meson C2 C3 C5 a_val_group extended_ordered_abelian_group.anti_symm one_is_val)
          then show ?thesis
            by (metis (no_types) C6 monoid.select_convs(1) valuation_ring_def)
        qed
        from this show "x \<otimes>\<^bsub>\<O>\<^esub> a \<in> \<mm>"
          by (metis (mono_tags, lifting) "0" "1" CollectI \<open>\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> (x \<otimes>\<^bsub>\<O>\<^esub> a)\<close>
              cring.cring_simprules(5) domain.axioms(1) maximal_ideal_def
              maximal_ideal_in_val_ring subringE(1) subsetCE val_ring_domain val_ring_subring)
      qed
    qed
  qed
  have I3:"\<And>a x. \<lbrakk>a \<in> \<mm>; x \<in> carrier \<O>\<rbrakk> \<Longrightarrow> a \<otimes>\<^bsub>\<O>\<^esub> x \<in> \<mm>"
  proof-
    fix a x
    show "\<lbrakk>a \<in> \<mm>; x \<in> carrier \<O>\<rbrakk> \<Longrightarrow> a \<otimes>\<^bsub>\<O>\<^esub> x \<in> \<mm>"
    proof-
      assume A1: "a \<in> \<mm>"
      assume A2: "x \<in> carrier \<O>"
      show "a \<otimes>\<^bsub>\<O>\<^esub> x \<in> \<mm>" using A1 A2 I2
        by (metis (no_types, lifting) cring.cring_simprules(14)
            domain.axioms(1) maximal_ideal_in_val_ring subsetCE val_ring_domain)
    qed
  qed
  from I1 I2 I3 idealI show ?thesis
    using cring_def domain.axioms(1) val_ring_domain by blast
qed

lemma (in valued_field) maximal_ideal_maximal:
  "maximalideal \<mm> \<O>"
proof(rule maximalidealI)
  show "ideal \<mm> \<O>"
    by (simp add: maximal_ideal_is_ideal)
  show "carrier \<O> \<noteq> \<mm>"
    by (metis (mono_tags, lifting) maximal_ideal_def
        mem_Collect_eq subringE(3) val_one val_ring_subring)
  show "\<And>J. ideal J \<O> \<Longrightarrow> \<mm> \<subseteq> J \<Longrightarrow> J \<subseteq> carrier \<O> \<Longrightarrow> J = \<mm> \<or> J = carrier \<O> "
  proof-
    fix J
    assume 0: "ideal J \<O>"
    assume 1: "\<mm> \<subseteq> J"
    assume 2: "J \<subseteq> carrier \<O>"
    show "(J = \<mm> \<or> (J = carrier \<O>))"
    proof (cases "J = \<mm>")
      case True
        then  show "(J = \<mm> \<or> (J = carrier \<O>))" by auto
      next
      case False
        from False and 1  have "\<exists> x. x \<in> J \<and> x \<notin> \<mm>"  by blast
        from this obtain x where C0: " x \<in> J \<and> x \<notin> \<mm>" by auto
        from 2 have "\<one>\<^bsub>\<Gamma>\<^esub> \<preceq>\<^bsub>\<Gamma>\<^esub> \<nu> x"
          by (meson C0 subringE(1) subsetCE val_ring_subring
              valued_ring.in_val_ring_conv valued_ring_axioms)
        from this and C0 have C1: "\<one>\<^bsub>\<Gamma>\<^esub> =  \<nu> x"
          using "2" maximal_ideal_def subringE(1) val_ring_subring by fastforce
        have C2: "x \<in> carrier K"
          by (meson "2" C0 subringE(1) subsetCE val_ring_subring)
        from C1 C2 val_ring_units have "x \<in> Units \<O>"
          using "2" C0 by auto
        from this and Units_def have "\<exists> y  \<in> carrier \<O>. y \<otimes>\<^bsub>\<O>\<^esub> x = \<one>\<^bsub>\<O>\<^esub> \<and>  x \<otimes>\<^bsub>\<O>\<^esub> y = \<one>\<^bsub>\<O>\<^esub>"
          by (simp add: Units_def)
        from this obtain y where
        "y  \<in> carrier \<O>\<and> y \<otimes>\<^bsub>\<O>\<^esub> x = \<one>\<^bsub>\<O>\<^esub> \<and>  x \<otimes>\<^bsub>\<O>\<^esub> y = \<one>\<^bsub>\<O>\<^esub>" by auto
        from this C0 and 0 have "\<one>\<^bsub>\<O>\<^esub> \<in> J" using ideal.I_r_closed by fastforce
        from this and 0 have "J =  carrier \<O>"
          using ideal.one_imp_carrier by blast
        then  show "(J = \<mm> \<or> (J = carrier \<O>))" by auto
      qed
    qed
  qed

lemma (in valued_field) res_field_is_field:
  "Ring.field k"
proof-
  show  "Ring.field k"
    using maximal_ideal_maximal  val_ring_subring residue_field_def
    by (simp add: residue_field_def domain.axioms(1) maximalideal.quotient_is_field val_ring_domain)
qed

end


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


(*  Author:     Tobias Nipkow, 2007  *)

theory QEdlo_ex imports QEdlo
begin

(* tweaking the reflection setup *)

definition "interpret" :: "atom fm \<Rightarrow> 'a::dlo list \<Rightarrow> bool" where
"interpret = Logic.interpret I\<^sub>d\<^sub>l\<^sub>o"

lemma interpret_Atoms:
  "interpret (Atom (Eq i j)) xs = (xs!i = xs!j)"
  "interpret (Atom (Less i j)) xs = (xs!i < xs!j)"
by(simp_all add:interpret_def)

lemma interpret_others:
  "interpret (Neg(ExQ (Neg f))) xs = (\<forall>x. interpret f (x#xs))"
  "interpret (Or (Neg f1) f2) xs = (interpret f1 xs \<longrightarrow> interpret f2 xs)"
by(simp_all add:interpret_def)

lemmas reify_eqs =
  Logic.interpret.simps(1,2,4-7)[of I\<^sub>d\<^sub>l\<^sub>o, folded interpret_def]
  interpret_others interpret_Atoms

method_setup dlo_reify = \<open>
  Scan.succeed
  (fn ctxt =>
    Method.SIMPLE_METHOD' (Reification.tac ctxt @{thms reify_eqs} NONE
     THEN' simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm"interpret_def"}])))
\<close> "dlo reification"

(* leave just enough equations in to convert back to True/False by eval *)
declare I\<^sub>d\<^sub>l\<^sub>o.simps(1)[code]
declare Logic.interpret.simps[code del]
declare Logic.interpret.simps(1-2)[code]

subsection\<open>Examples\<close>

lemma "\<forall>x::real. \<not> x < x"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
by eval

lemma "\<forall>x y::real. \<exists>z. x < y \<longrightarrow> x < z \<and> z < y"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
by eval

lemma "\<exists> x::real. a+b < x \<and> x < c*d"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
apply normalization
oops

lemma "\<forall>x::real. \<not> x < x"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
by eval

lemma "\<forall>x y::real. \<exists>z. x < y \<longrightarrow> x < z \<and> z < y"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
by eval

(* 160 secs *)
lemma "\<not>(\<exists>x y z. \<forall>u::real. x < x \<or> \<not> x<u \<or> x<y \<and> y<z \<and> \<not> x<z)"
apply dlo_reify
apply (subst I_qe_dlo [symmetric])
by eval

lemma "qe_dlo(AllQ (Imp (Atom(Less 0 1)) (Atom(Less 1 0)))) = FalseF"
by eval

lemma "qe_dlo(AllQ(AllQ (Imp (Atom(Less 0 1)) (Atom(Less 0 1))))) = TrueF"
by eval

lemma
  "qe_dlo(AllQ(ExQ(AllQ (And (Atom(Less 2 1)) (Atom(Less 1 0)))))) = FalseF"
by eval

lemma "qe_dlo(AllQ(ExQ(ExQ (And (Atom(Less 1 2)) (Atom(Less 2 0)))))) = TrueF"
by eval

lemma
  "qe_dlo(AllQ(AllQ(ExQ (And (Atom(Less 1 0)) (Atom(Less 0 2)))))) = FalseF"
by eval

lemma "qe_dlo(AllQ(AllQ(ExQ (Imp (Atom(Less 1 2)) (And (Atom(Less 1 0)) (Atom(Less 0 2))))))) = TrueF"
by eval

value "qe_dlo(AllQ (Imp (Atom(Less 0 1)) (Atom(Less 0 2))))"

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

datatype Nat = Z | S "Nat"

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

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

fun formulapow3 :: "Nat => Nat => Nat" where
"formulapow3 x (Z) = S Z"
| "formulapow3 x (S z) = times x (formulapow3 x z)"

fun formulapow2 :: "Nat => Nat => Nat" where
"formulapow2 x (Z) = S Z"
| "formulapow2 x (S z) = times x (formulapow2 x z)"

fun formulapow :: "Nat => Nat => Nat" where
"formulapow x (Z) = S Z"
| "formulapow x (S z) = times x (formulapow x z)"

theorem property0 :
  "((plus
       (formulapow (plus (S Z) x) (plus (S (S (S Z))) n))
       (formulapow2 (plus (S Z) y) (plus (S (S (S Z))) n))) ~=
      (formulapow3 (plus (S Z) z) (plus (S (S (S Z))) n)))"
  oops

end


(*  Title:      ZF/IMP/Denotation.thy
    Author:     Heiko Loetzbeyer and Robert Sandner, TU München
*)

section \<open>Denotational semantics of expressions and commands\<close>

theory Denotation imports Com begin

subsection \<open>Definitions\<close>

consts
  A     :: "i => i => i"
  B     :: "i => i => i"
  C     :: "i => i"

definition
  Gamma :: "[i,i,i] => i"  ("\<Gamma>") where
  "\<Gamma>(b,cden) ==
    (\<lambda>phi. {io \<in> (phi O cden). B(b,fst(io))=1} \<union>
           {io \<in> id(loc->nat). B(b,fst(io))=0})"

primrec
  "A(N(n), sigma) = n"
  "A(X(x), sigma) = sigma`x"
  "A(Op1(f,a), sigma) = f`A(a,sigma)"
  "A(Op2(f,a0,a1), sigma) = f`<A(a0,sigma),A(a1,sigma)>"

primrec
  "B(true, sigma) = 1"
  "B(false, sigma) = 0"
  "B(ROp(f,a0,a1), sigma) = f`<A(a0,sigma),A(a1,sigma)>"
  "B(noti(b), sigma) = not(B(b,sigma))"
  "B(b0 andi b1, sigma) = B(b0,sigma) and B(b1,sigma)"
  "B(b0 ori b1, sigma) = B(b0,sigma) or B(b1,sigma)"

primrec
  "C(\<SKIP>) = id(loc->nat)"
  "C(x \<ASSN> a) =
    {io \<in> (loc->nat) \<times> (loc->nat). snd(io) = fst(io)(x := A(a,fst(io)))}"
  "C(c0\<SEQ> c1) = C(c1) O C(c0)"
  "C(\<IF> b \<THEN> c0 \<ELSE> c1) =
    {io \<in> C(c0). B(b,fst(io)) = 1} \<union> {io \<in> C(c1). B(b,fst(io)) = 0}"
  "C(\<WHILE> b \<DO> c) = lfp((loc->nat) \<times> (loc->nat), \<Gamma>(b,C(c)))"

subsection \<open>Misc lemmas\<close>

lemma A_type [TC]: "[|a \<in> aexp; sigma \<in> loc->nat|] ==> A(a,sigma) \<in> nat"
  by (erule aexp.induct) simp_all

lemma B_type [TC]: "[|b \<in> bexp; sigma \<in> loc->nat|] ==> B(b,sigma) \<in> bool"
by (erule bexp.induct, simp_all)

lemma C_subset: "c \<in> com ==> C(c) \<subseteq> (loc->nat) \<times> (loc->nat)"
  apply (erule com.induct)
      apply simp_all
      apply (blast dest: lfp_subset [THEN subsetD])+
  done

lemma C_type_D [dest]:
    "[| <x,y> \<in> C(c); c \<in> com |] ==> x \<in> loc->nat & y \<in> loc->nat"
  by (blast dest: C_subset [THEN subsetD])

lemma C_type_fst [dest]: "[| x \<in> C(c); c \<in> com |] ==> fst(x) \<in> loc->nat"
  by (auto dest!: C_subset [THEN subsetD])

lemma Gamma_bnd_mono:
  "cden \<subseteq> (loc->nat) \<times> (loc->nat)
    ==> bnd_mono ((loc->nat) \<times> (loc->nat), \<Gamma>(b,cden))"
  by (unfold bnd_mono_def Gamma_def) blast

end


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

datatype Nat = Z | S "Nat"

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

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

theorem property0 :
  "((t2 (t22 k m) (t22 k n)) = (t2 m n))"
  oops

end


(* Author: Gerwin Klein, Tobias Nipkow *)

theory Big_Step imports Com "~~/src/HOL/Eisbach/Eisbach" begin

subsection "Big-Step Semantics of Commands"

text {*
The big-step semantics is a straight-forward inductive definition
with concrete syntax. Note that the first parameter is a tuple,
so the syntax becomes @{text "(c,s) \<Rightarrow> s'"}.
*}

text_raw{*\snip{BigStepdef}{0}{1}{% *}
inductive
  big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where
Skip: "(SKIP,s) \<Rightarrow> s" |
Assign: "(x ::= a,s) \<Rightarrow> s(x := aval a s)" |
Seq: "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
IfTrue: "\<lbrakk> bval b s;  (c\<^sub>1,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
IfFalse: "\<lbrakk> \<not>bval b s;  (c\<^sub>2,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> s" |
WhileTrue:
"\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
\<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3"
text_raw{*}%endsnip*}

text \<open>Derivation Tree: Forward\<close>

thm
  Seq[OF
    Assign[of "''x''" "N 5"]
    Assign[of "''y''" "V ''x''"]
  ]

text \<open>Using @{attribute simplified} to evaluate arithmetic expression\<close>
thm
  Seq[OF
    Assign[of "''x''" "N 5"]
    Assign[of "''y''" "V ''x''"],
    simplified
  ]

locale DerTreeExample (* Isabelle's mechanism to make the following
  abbreviations only locally visible. Roughly a declaration of a "module" *)
begin
  abbreviation "b \<equiv> Less (V ''x'') (N 2)"
  abbreviation "c \<equiv> ''x'' ::= Plus (V ''x'') (N 1)"
  abbreviation "w \<equiv> WHILE b DO c"

  thm
    WhileTrue[of b "<>" c, OF _
      Assign
      WhileTrue[OF _
        Assign
        WhileFalse
      ],
    simplified]

  text \<open>Derivation Tree: Backwards\<close>
  schematic_goal [simplified]: "(w,<>) \<Rightarrow> ?s"
    apply (rule WhileTrue)
      apply simp
      apply (rule Assign)
      apply (rule WhileTrue)
        apply simp
        apply (rule Assign)
        apply (rule WhileFalse)
          apply simp
    done

  (* We can use [simplified] attribute to evaluate all these \<open>aval\<close>s *)
  schematic_goal [simplified]: "(w,<>) \<Rightarrow> ?s"
    apply (rule WhileTrue)
    apply simp
    apply (rule Assign)
    apply (rule WhileTrue)
    apply simp
    apply (rule Assign)
    apply (rule WhileFalse)
    apply simp
    done

end

text \<open>This looks quite canonical ... Indeed\<close>

method If = (rule IfTrue, (simp;fail)) | (rule IfFalse, (simp;fail))
method While = (rule WhileTrue, (simp;fail)) | (rule WhileFalse, (simp;fail))
method BigStep = simp?; ((rule Skip Assign Seq) | If | While)
method BigSteps = BigStep+

context DerTreeExample begin
  schematic_goal [simplified]: "(w,<>) \<Rightarrow> ?s"
    by BigSteps

  abbreviation "square \<equiv>
    ''a'' ::= N 0;;
    ''b'' ::= N 1;;
    WHILE Less (N 0) (V ''x'') DO (
      ''a'' ::= Plus (V ''a'') (V ''b'');;
      ''b'' ::= Plus (V ''b'') (N 2);;
      ''x'' ::= Plus (V ''x'') (N (-1))
    )
  "

  schematic_goal [simplified]: "(square,<''x'':=5>) \<Rightarrow> ?s"
    by BigSteps

end

(******** Back to slides ********)

text{* Proof automation: *}

text {* The introduction rules are good for automatically
construction small program executions. The recursive cases
may require backtracking, so we declare the set as unsafe
intro rules. *}
declare big_step.intros [intro]

text{* The standard induction rule
@{thm [display] big_step.induct [no_vars]} *}

thm big_step.induct

text{*
This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the @{text c}, @{text s},
and @{text s'} that we are likely to encounter. Splitting
the tuple parameter fixes this:
*}
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct
text {*
@{thm [display] big_step_induct [no_vars]}
*}

subsection "Rule inversion"

text{* What can we deduce from @{prop "(SKIP,s) \<Rightarrow> t"} ?
That @{prop "s = t"}. This is how we can automatically prove it: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<Rightarrow> t"
thm SkipE

text{* This is an \emph{elimination rule}. The [elim] attribute tells auto,
blast and friends (but not simp!) to use it automatically; [elim!] means that
it is applied eagerly.

Similarly for the other commands: *}

inductive_cases AssignE[elim!]: "(x ::= a,s) \<Rightarrow> t"
thm AssignE
inductive_cases SeqE[elim!]: "(c1;;c2,s1) \<Rightarrow> s3"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> t"
thm IfE

inductive_cases WhileE[elim]: "(WHILE b DO c,s) \<Rightarrow> t"
thm WhileE
text{* Only [elim]: [elim!] would not terminate. *}

(*declare WhileE[rule del]

  note WhileE[rule del]

  supply WhileE[rule del]

*)

text{* An automatic example: *}

lemma "(IF b THEN SKIP ELSE SKIP, s) \<Rightarrow> t \<Longrightarrow> t = s"
by blast

text{* Rule inversion by hand via the ``cases'' method: *}

lemma assumes "(IF b THEN SKIP ELSE SKIP, s) \<Rightarrow> t"
shows "t = s"
proof-
  from assms show ?thesis
  proof cases  --"inverting assms"
    case IfTrue thm IfTrue
    thus ?thesis by blast
  next
    case IfFalse thus ?thesis by blast
  qed
qed

(* Using rule inversion to prove simplification rules: *)
lemma assign_simp:
  "(x ::= a,s) \<Rightarrow> s' \<longleftrightarrow> (s' = s(x := aval a s))"
  by auto

text {* An example combining rule inversion and derivations *}
lemma Seq_assoc:
  "((c1;; c2);; c3, s) \<Rightarrow> s' \<longleftrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> s'"
proof
  assume "(c1;; c2;; c3, s) \<Rightarrow> s'"
  then obtain s1 s2 where
    c1: "(c1, s) \<Rightarrow> s1" and
    c2: "(c2, s1) \<Rightarrow> s2" and
    c3: "(c3, s2) \<Rightarrow> s'" by auto
  from c2 c3
  have "(c2;; c3, s1) \<Rightarrow> s'" by (rule Seq)
  with c1
  show "(c1;; (c2;; c3), s) \<Rightarrow> s'" by (rule Seq)
next
  -- "The other direction is analogous"
  assume "(c1;; (c2;; c3), s) \<Rightarrow> s'"
  thus "(c1;; c2;; c3, s) \<Rightarrow> s'" by auto
qed

(****** Back to Slides ******)

subsection "Command Equivalence"
(****** NOT IN THIS LECTURE!   ******)

text {*
  We call two statements @{text c} and @{text c'} equivalent wrt.\ the
  big-step semantics when \emph{@{text c} started in @{text s} terminates
  in @{text s'} iff @{text c'} started in the same @{text s} also terminates
  in the same @{text s'}}. Formally:
*}
text_raw{*\snip{BigStepEquiv}{0}{1}{% *}
abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c,s) \<Rightarrow> t  =  (c',s) \<Rightarrow> t)"
text_raw{*}%endsnip*}

text {*
Warning: @{text"\<sim>"} is the symbol written \verb!\ < s i m >! (without spaces).

  As an example, we show that loop unfolding is an equivalence
  transformation on programs:
*}
lemma unfold_while:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w \<sim> ?iw")
proof -
  -- "to show the equivalence, we look at the derivation tree for"
  -- "each side and from that construct a derivation tree for the other side"
  { fix s t assume "(?w, s) \<Rightarrow> t"
    -- "as a first thing we note that, if @{text b} is @{text False} in state @{text s},"
    -- "then both statements do nothing:"
    { assume "\<not>bval b s"
      hence "t = s" using `(?w,s) \<Rightarrow> t` by blast
      hence "(?iw, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then only the @{text WhileTrue} rule can have been used to derive @{text "(?w, s) \<Rightarrow> t"} *}
    { assume "bval b s"
      with `(?w, s) \<Rightarrow> t` obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "now we can build a derivation tree for the @{text IF}"
      -- "first, the body of the True-branch:"
      hence "(c;; ?w, s) \<Rightarrow> t" by (rule Seq)
      -- "then the whole @{text IF}"
      with `bval b s` have "(?iw, s) \<Rightarrow> t" by (rule IfTrue)
    }
    ultimately
    -- "both cases together give us what we want:"
    have "(?iw, s) \<Rightarrow> t" by blast
  }
  moreover
  -- "now the other direction:"
  { fix s t assume "(?iw, s) \<Rightarrow> t"
    -- "again, if @{text b} is @{text False} in state @{text s}, then the False-branch"
    -- "of the @{text IF} is executed, and both statements do nothing:"
    { assume "\<not>bval b s"
      hence "s = t" using `(?iw, s) \<Rightarrow> t` by blast
      hence "(?w, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then this time only the @{text IfTrue} rule can have be used *}
    { assume "bval b s"
      with `(?iw, s) \<Rightarrow> t` have "(c;; ?w, s) \<Rightarrow> t" by auto
      -- "and for this, only the Seq-rule is applicable:"
      then obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "with this information, we can build a derivation tree for the @{text WHILE}"
      with `bval b s`
      have "(?w, s) \<Rightarrow> t" by (rule WhileTrue)
    }
    ultimately
    -- "both cases together again give us what we want:"
    have "(?w, s) \<Rightarrow> t" by blast
  }
  ultimately
  show ?thesis by blast
qed

text {* Luckily, such lengthy proofs are seldom necessary.  Isabelle can
prove many such facts automatically.  *}

lemma while_unfold:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)"
by blast

lemma triv_if:
  "(IF b THEN c ELSE c) \<sim> c"
by blast

lemma commute_if:
  "(IF b1 THEN (IF b2 THEN c11 ELSE c12) ELSE c2)
   \<sim>
   (IF b2 THEN (IF b1 THEN c11 ELSE c2) ELSE (IF b1 THEN c12 ELSE c2))"
by blast

lemma sim_while_cong_aux:
  "(WHILE b DO c,s) \<Rightarrow> t  \<Longrightarrow> c \<sim> c' \<Longrightarrow>  (WHILE b DO c',s) \<Rightarrow> t"
apply(induction "WHILE b DO c" s t arbitrary: b c rule: big_step_induct)
 apply blast
apply blast
done

lemma sim_while_cong: "c \<sim> c' \<Longrightarrow> WHILE b DO c \<sim> WHILE b DO c'"
by (metis sim_while_cong_aux)

text {* Command equivalence is an equivalence relation, i.e.\ it is
reflexive, symmetric, and transitive. Because we used an abbreviation
above, Isabelle derives this automatically. *}

lemma sim_refl:  "c \<sim> c" by simp
lemma sim_sym:   "(c \<sim> c') = (c' \<sim> c)" by auto
lemma sim_trans: "c \<sim> c' \<Longrightarrow> c' \<sim> c'' \<Longrightarrow> c \<sim> c''" by auto

(***** END: NOT IN THIS LECTURE ******)

subsection "Execution is deterministic"

text {* This proof is automatic. *}

theorem big_step_determ: "\<lbrakk> (c,s) \<Rightarrow> t; (c,s) \<Rightarrow> u \<rbrakk> \<Longrightarrow> u = t"
  by (induction arbitrary: u rule: big_step.induct) blast+

text {*
  This is the proof as you might present it in a lecture. The remaining
  cases are simple enough to be proved automatically:
*}
text_raw{*\snip{BigStepDetLong}{0}{2}{% *}
theorem
  "(c,s) \<Rightarrow> t  \<Longrightarrow>  (c,s) \<Rightarrow> t'  \<Longrightarrow>  t' = t"
proof (induction arbitrary: t' rule: big_step.induct)
  -- "the only interesting case, @{text WhileTrue}:"
  fix b c s s\<^sub>1 t t'
  -- "The assumptions of the rule:"
  assume "bval b s" and "(c,s) \<Rightarrow> s\<^sub>1" and "(WHILE b DO c,s\<^sub>1) \<Rightarrow> t"
  -- {* Ind.Hyp; note the @{text"\<And>"} because of arbitrary: *}
  assume IHc: "\<And>t'. (c,s) \<Rightarrow> t' \<Longrightarrow> t' = s\<^sub>1"
  assume IHw: "\<And>t'. (WHILE b DO c,s\<^sub>1) \<Rightarrow> t' \<Longrightarrow> t' = t"
  -- "Premise of implication:"
  assume "(WHILE b DO c,s) \<Rightarrow> t'"
  with `bval b s` obtain s\<^sub>1' where
      c: "(c,s) \<Rightarrow> s\<^sub>1'" and
      w: "(WHILE b DO c,s\<^sub>1') \<Rightarrow> t'"
    by auto
  from c IHc have "s\<^sub>1' = s\<^sub>1" by blast
  with w IHw show "t' = t" by blast
qed blast+ -- "prove the rest automatically"
text_raw{*}%endsnip*}

end


theory BaseAllenHayes = Main:

 (*
  author: Stefan Woelfl
  date:   05-11-2004

  Summary:
  =======
  This thy file contains the basics of Allen and Hayes' first order
  axiomatization of intervals in linear time.
  We prove that the basic Meet relation ("M") is irreflexiv, asymetric, and
  transitive.

  The proofs here are just brute force.
*)

typedecl "Interval"

consts
"M" :: "Interval => Interval => bool"   ( "M" )

axioms
M1: "!! x y z u :: Interval .
  (M x y & M x u) & M z y ==> M z u"
M2a: "!! x y z u :: Interval .
  M x y & M z u ==> (M x u | (? v :: Interval . M x v & M v u)) | (? v :: Interval . M z v & M v y)"
M2b: "!! x y z u :: Interval . M x y & M z u & M x u ==>
  (Not (? v :: Interval . M x v & M v u)) & (Not (? v :: Interval . M z v & M v y))"
M2c: "!! x y z u :: Interval . (M x y & M z u) & (? v :: Interval . M x v & M v u) ==>
  (Not (M x u)) & (Not (? v :: Interval . M z v & M v y))"
M2d: "!! x y z u :: Interval . (M x y & M z u) & (? v :: Interval . M z v & M v y) ==>
  (Not (M x u)) & (Not (? v :: Interval . M x v & M v u))"
M3: "!! x :: Interval . ? y :: Interval . ? z :: Interval . M y x & M x z"
M4: "!! x y z u :: Interval .
  ((M x y & M y u) & M x z) & M z u ==> y = z"

theorem M_irrefl[intro]: "!! x :: Interval . (Not (M x x))"
proof -
  fix x
  from M2b
  show "Not(M x x)" by blast
qed

theorem M_asym[intro]: "!! x :: Interval . !! y :: Interval . M x y ==> (Not (M y x))"
proof -
  fix x y
  assume "M x y"
  with M2b M2c
  show "(Not (M y x))"
    by blast
qed

theorem M_atrans[intro]: "!! x :: Interval . !! y :: Interval . !! z :: Interval . M x y & M y z ==> (Not (M x z))"
proof -
  fix x y z
  assume " M x y & M y z"
  with M2c
  show "Not (M x z)"
    by blast
qed

end


(*  Title:      HOL/UNITY/Detects.thy
    Author:     Tanja Vos, Cambridge University Computer Laboratory
    Copyright   2000  University of Cambridge

Detects definition (Section 3.8 of Chandy & Misra) using LeadsTo
*)

section{*The Detects Relation*}

theory Detects imports FP SubstAx begin

definition Detects :: "['a set, 'a set] => 'a program set"  (infixl "Detects" 60)
  where "A Detects B = (Always (-A \<union> B)) \<inter> (B LeadsTo A)"

definition Equality :: "['a set, 'a set] => 'a set"  (infixl "<==>" 60)
  where "A <==> B = (-A \<union> B) \<inter> (A \<union> -B)"

(* Corollary from Sectiom 3.6.4 *)

lemma Always_at_FP:
     "[|F \<in> A LeadsTo B; all_total F|] ==> F \<in> Always (-((FP F) \<inter> A \<inter> -B))"
apply (rule LeadsTo_empty)
apply (subgoal_tac "F \<in> (FP F \<inter> A \<inter> - B) LeadsTo (B \<inter> (FP F \<inter> -B))")
apply (subgoal_tac [2] " (FP F \<inter> A \<inter> - B) = (A \<inter> (FP F \<inter> -B))")
apply (subgoal_tac "(B \<inter> (FP F \<inter> -B)) = {}")
apply auto
apply (blast intro: PSP_Stable stable_imp_Stable stable_FP_Int)
done

lemma Detects_Trans:
     "[| F \<in> A Detects B; F \<in> B Detects C |] ==> F \<in> A Detects C"
apply (unfold Detects_def Int_def)
apply (simp (no_asm))
apply safe
apply (rule_tac [2] LeadsTo_Trans, auto)
apply (subgoal_tac "F \<in> Always ((-A \<union> B) \<inter> (-B \<union> C))")
 apply (blast intro: Always_weaken)
apply (simp add: Always_Int_distrib)
done

lemma Detects_refl: "F \<in> A Detects A"
apply (unfold Detects_def)
apply (simp (no_asm) add: Un_commute Compl_partition subset_imp_LeadsTo)
done

lemma Detects_eq_Un: "(A<==>B) = (A \<inter> B) \<union> (-A \<inter> -B)"
by (unfold Equality_def, blast)

(*Not quite antisymmetry: sets A and B agree in all reachable states *)
lemma Detects_antisym:
     "[| F \<in> A Detects B;  F \<in> B Detects A|] ==> F \<in> Always (A <==> B)"
apply (unfold Detects_def Equality_def)
apply (simp add: Always_Int_I Un_commute)
done

(* Theorem from Section 3.8 *)

lemma Detects_Always:
     "[|F \<in> A Detects B; all_total F|] ==> F \<in> Always (-(FP F) \<union> (A <==> B))"
apply (unfold Detects_def Equality_def)
apply (simp add: Un_Int_distrib Always_Int_distrib)
apply (blast dest: Always_at_FP intro: Always_weaken)
done

(* Theorem from exercise 11.1 Section 11.3.1 *)

lemma Detects_Imp_LeadstoEQ:
     "F \<in> A Detects B ==> F \<in> UNIV LeadsTo (A <==> B)"
apply (unfold Detects_def Equality_def)
apply (rule_tac B = B in LeadsTo_Diff)
 apply (blast intro: Always_LeadsToI subset_imp_LeadsTo)
apply (blast intro: Always_LeadsTo_weaken)
done

end