(* Title:      N-Semirings
   Author:     Walter Guttmann
   Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
*)

section \<open>N-Semirings\<close>

theory N_Semirings

imports Test_Iterings Omega_Algebras

begin

class n_semiring = bounded_idempotent_left_zero_semiring + n + L +
  assumes n_bot         : "n(bot) = bot"
  assumes n_top         : "n(top) = 1"
  assumes n_dist_sup    : "n(x \<squnion> y) = n(x) \<squnion> n(y)"
  assumes n_export      : "n(n(x) * y) = n(x) * n(y)"
  assumes n_sub_mult_bot: "n(x) = n(x * bot) * n(x)"
  assumes n_L_split     : "x * n(y) * L = x * bot \<squnion> n(x * y) * L"
  assumes n_split       : "x \<le> x * bot \<squnion> n(x * L) * top"
begin

lemma n_sub_one:
  "n(x) \<le> 1"
  by (metis sup_left_top sup_ge2 n_dist_sup n_top)

text \<open>Theorem 15\<close>

lemma n_isotone:
  "x \<le> y \<Longrightarrow> n(x) \<le> n(y)"
  by (metis le_iff_sup n_dist_sup)

lemma n_mult_idempotent:
  "n(x) * n(x) = n(x)"
  by (metis mult_assoc mult_1_right n_export n_sub_mult_bot n_top)

text \<open>Theorem 15.3\<close>

lemma n_mult_bot:
  "n(x) = n(x * bot)"
  by (metis sup_commute sup_left_top sup_bot_right mult_left_dist_sup mult_1_right n_dist_sup n_sub_mult_bot n_top)

lemma n_mult_left_upper_bound:
  "n(x) \<le> n(x * y)"
  by (metis mult_right_isotone n_isotone n_mult_bot bot_least)

lemma n_mult_right_bot:
  "n(x) * bot = bot"
  by (metis sup_left_top sup_bot_left mult_left_one mult_1_right n_export n_dist_sup n_sub_mult_bot n_top n_bot)

text \<open>Theorem 15.9\<close>

lemma n_mult_n:
  "n(x * n(y)) = n(x)"
  by (metis mult_assoc n_mult_right_bot n_mult_bot)

lemma n_mult_left_absorb_sup:
  "n(x) * (n(x) \<squnion> n(y)) = n(x)"
  by (metis sup_left_top mult_left_dist_sup mult_1_right n_dist_sup n_mult_idempotent n_top)

lemma n_mult_right_absorb_sup:
  "(n(x) \<squnion> n(y)) * n(y) = n(y)"
  by (metis sup_commute sup_left_top mult_left_one mult_right_dist_sup n_dist_sup n_mult_idempotent n_top)

lemma n_sup_left_absorb_mult:
  "n(x) \<squnion> n(x) * n(y) = n(x)"
  using mult_left_dist_sup n_mult_idempotent n_mult_left_absorb_sup by auto

lemma n_sup_right_absorb_mult:
  "n(x) * n(y) \<squnion> n(y) = n(y)"
  using mult_right_dist_sup n_mult_idempotent n_mult_right_absorb_sup by auto

lemma n_mult_commutative:
  "n(x) * n(y) = n(y) * n(x)"
  by (smt sup_commute mult_left_dist_sup mult_right_dist_sup n_sup_left_absorb_mult n_sup_right_absorb_mult n_export n_mult_idempotent)

lemma n_sup_left_dist_mult:
  "n(x) \<squnion> n(y) * n(z) = (n(x) \<squnion> n(y)) * (n(x) \<squnion> n(z))"
  by (metis sup_assoc mult_left_dist_sup mult_right_dist_sup n_sup_right_absorb_mult n_mult_commutative n_mult_left_absorb_sup)

lemma n_sup_right_dist_mult:
  "n(x) * n(y) \<squnion> n(z) = (n(x) \<squnion> n(z)) * (n(y) \<squnion> n(z))"
  by (simp add: sup_commute n_sup_left_dist_mult)

lemma n_order:
  "n(x) \<le> n(y) \<longleftrightarrow> n(x) * n(y) = n(x)"
  by (metis le_iff_sup n_sup_right_absorb_mult n_mult_left_absorb_sup)

lemma n_mult_left_lower_bound:
  "n(x) * n(y) \<le> n(x)"
  by (simp add: sup.orderI n_sup_left_absorb_mult)

lemma n_mult_right_lower_bound:
  "n(x) * n(y) \<le> n(y)"
  by (simp add: le_iff_sup n_sup_right_absorb_mult)

lemma n_mult_least_upper_bound:
  "n(x) \<le> n(y) \<and> n(x) \<le> n(z) \<longleftrightarrow> n(x) \<le> n(y) * n(z)"
  by (metis order.trans mult_left_isotone n_mult_commutative n_mult_right_lower_bound n_order)

lemma n_mult_left_divisibility:
  "n(x) \<le> n(y) \<longleftrightarrow> (\<exists>z . n(x) = n(y) * n(z))"
  by (metis n_mult_commutative n_mult_left_lower_bound n_order)

lemma n_mult_right_divisibility:
  "n(x) \<le> n(y) \<longleftrightarrow> (\<exists>z . n(x) = n(z) * n(y))"
  by (simp add: n_mult_commutative n_mult_left_divisibility)

text \<open>Theorem 15.1\<close>

lemma n_one:
  "n(1) = bot"
  by (metis mult_left_one n_mult_bot n_bot)

lemma n_split_equal:
  "x \<squnion> n(x * L) * top = x * bot \<squnion> n(x * L) * top"
  using n_split order_trans sup.cobounded1 sup_same_context zero_right_mult_decreasing by blast

lemma n_split_top:
  "x * top \<le> x * bot \<squnion> n(x * L) * top"
  by (metis mult_left_isotone n_split vector_bot_closed vector_mult_closed vector_sup_closed vector_top_closed)

text \<open>Theorem 15.2\<close>

lemma n_L:
  "n(L) = 1"
  by (metis sup_bot_left order.antisym mult_left_one n_export n_isotone n_mult_commutative n_split_top n_sub_one n_top)

text \<open>Theorem 15.5\<close>

lemma n_split_L:
  "x * L = x * bot \<squnion> n(x * L) * L"
  by (metis mult_1_right n_L n_L_split)

lemma n_n_L:
  "n(n(x) * L) = n(x)"
  by (simp add: n_export n_L)

lemma n_L_decreasing:
  "n(x) * L \<le> x"
  by (metis mult_left_zero n_L_split order_trans sup.orderI zero_right_mult_decreasing mult_assoc n_mult_bot)

text \<open>Theorem 15.10\<close>

lemma n_galois:
  "n(x) \<le> n(y) \<longleftrightarrow> n(x) * L \<le> y"
  by (metis order.trans mult_left_isotone n_L_decreasing n_isotone n_n_L)

text \<open>Theorem 15.6\<close>

lemma split_L:
  "x * L \<le> x * bot \<squnion> L"
  by (metis sup_commute sup_left_isotone n_galois n_L n_split_L n_sub_one)

text \<open>Theorem 15.7\<close>

lemma L_left_zero:
  "L * x = L"
  by (metis order.antisym mult.left_neutral mult_left_zero zero_right_mult_decreasing n_L n_L_decreasing n_mult_bot mult.assoc)

text \<open>Theorem 15.8\<close>

lemma n_mult:
  "n(x * n(y) * L) = n(x * y)"
  using n_L_split n_dist_sup sup.absorb2 n_mult_left_upper_bound n_mult_bot n_n_L by auto

lemma n_mult_top:
  "n(x * n(y) * top) = n(x * y)"
  by (metis mult_1_right n_mult n_top)

text \<open>Theorem 15.4\<close>

lemma n_top_L:
  "n(x * top) = n(x * L)"
  by (metis mult_1_right n_L n_mult_top)

lemma n_top_split:
  "x * n(y) * top \<le> x * bot \<squnion> n(x * y) * top"
  by (metis mult_assoc n_mult n_mult_right_bot n_split_top)

lemma n_mult_right_upper_bound:
  "n(x * y) \<le> n(z) \<longleftrightarrow> n(x) \<le> n(z) \<and> x * n(y) * L \<le> x * bot \<squnion> n(z) * L"
  apply (rule iffI)
  apply (metis sup_right_isotone order.eq_iff mult_isotone n_L_split n_mult_left_upper_bound order_trans)
  by (smt (verit, ccfv_threshold) n_dist_sup n_export sup.absorb_iff2 n_mult n_mult_commutative n_mult_bot n_n_L)

lemma n_preserves_equation:
  "n(y) * x \<le> x * n(y) \<longleftrightarrow> n(y) * x = n(y) * x * n(y)"
  using eq_refl test_preserves_equation n_mult_idempotent n_sub_one by auto

definition ni :: "'a \<Rightarrow> 'a"
  where "ni x = n(x) * L"

lemma ni_bot:
  "ni(bot) = bot"
  by (simp add: n_bot ni_def)

lemma ni_one:
  "ni(1) = bot"
  by (simp add: n_one ni_def)

lemma ni_L:
  "ni(L) = L"
  by (simp add: n_L ni_def)

lemma ni_top:
  "ni(top) = L"
  by (simp add: n_top ni_def)

lemma ni_dist_sup:
  "ni(x \<squnion> y) = ni(x) \<squnion> ni(y)"
  by (simp add: mult_right_dist_sup n_dist_sup ni_def)

lemma ni_mult_bot:
  "ni(x) = ni(x * bot)"
  using n_mult_bot ni_def by auto

lemma ni_split:
  "x * ni(y) = x * bot \<squnion> ni(x * y)"
  using n_L_split mult_assoc ni_def by auto

lemma ni_decreasing:
  "ni(x) \<le> x"
  by (simp add: n_L_decreasing ni_def)

lemma ni_isotone:
  "x \<le> y \<Longrightarrow> ni(x) \<le> ni(y)"
  using mult_left_isotone n_isotone ni_def by auto

lemma ni_mult_left_upper_bound:
  "ni(x) \<le> ni(x * y)"
  using mult_left_isotone n_mult_left_upper_bound ni_def by force

lemma ni_idempotent:
  "ni(ni(x)) = ni(x)"
  by (simp add: n_n_L ni_def)

lemma ni_below_L:
  "ni(x) \<le> L"
  using n_L n_galois n_sub_one ni_def by auto

lemma ni_left_zero:
  "ni(x) * y = ni(x)"
  by (simp add: L_left_zero mult_assoc ni_def)

lemma ni_split_L:
  "x * L = x * bot \<squnion> ni(x * L)"
  using n_split_L ni_def by auto

lemma ni_top_L:
  "ni(x * top) = ni(x * L)"
  by (simp add: n_top_L ni_def)

lemma ni_galois:
  "ni(x) \<le> ni(y) \<longleftrightarrow> ni(x) \<le> y"
  by (metis n_galois n_n_L ni_def)

lemma ni_mult:
  "ni(x * ni(y)) = ni(x * y)"
  using mult_assoc n_mult ni_def by auto

lemma ni_n_order:
  "ni(x) \<le> ni(y) \<longleftrightarrow> n(x) \<le> n(y)"
  using n_galois ni_def ni_galois by auto

lemma ni_n_equal:
  "ni(x) = ni(y) \<longleftrightarrow> n(x) = n(y)"
  by (metis n_n_L ni_def)

lemma ni_mult_right_upper_bound:
  "ni(x * y) \<le> ni(z) \<longleftrightarrow> ni(x) \<le> ni(z) \<and> x * ni(y) \<le> x * bot \<squnion> ni(z)"
  using mult_assoc n_mult_right_upper_bound ni_def ni_n_order by auto

lemma n_ni:
  "n(ni(x)) = n(x)"
  by (simp add: n_n_L ni_def)

lemma ni_n:
  "ni(n(x)) = bot"
  by (metis n_mult_right_bot ni_mult_bot ni_bot)

lemma ni_n_galois:
  "n(x) \<le> n(y) \<longleftrightarrow> ni(x) \<le> y"
  by (simp add: n_galois ni_def)

lemma n_mult_ni:
  "n(x * ni(y)) = n(x * y)"
  using ni_mult ni_n_equal by auto

lemma ni_mult_n:
  "ni(x * n(y)) = ni(x)"
  by (simp add: n_mult_n ni_def)

lemma ni_export:
  "ni(n(x) * y) = n(x) * ni(y)"
  by (simp add: n_mult_right_bot ni_split)

lemma ni_mult_top:
  "ni(x * n(y) * top) = ni(x * y)"
  by (simp add: n_mult_top ni_def)

lemma ni_n_bot:
  "ni(x) = bot \<longleftrightarrow> n(x) = bot"
  using n_bot ni_n_equal ni_bot by force

lemma ni_n_L:
  "ni(x) = L \<longleftrightarrow> n(x) = 1"
  using n_L ni_L ni_n_equal by force

(* independence of axioms, checked in n_semiring without the respective axiom: *)
proposition n_bot         : "n(bot) = bot" (* nitpick [expect=genuine,card=2] *) oops
proposition n_top         : "n(top) = 1" (* nitpick [expect=genuine,card=3] *) oops
proposition n_dist_sup    : "n(x \<squnion> y) = n(x) \<squnion> n(y)" (* nitpick [expect=genuine,card=5] *) oops
proposition n_export      : "n(n(x) * y) = n(x) * n(y)" (* nitpick [expect=genuine,card=6] *) oops
proposition n_sub_mult_bot: "n(x) = n(x * bot) * n(x)" (* nitpick [expect=genuine,card=2] *) oops
proposition n_L_split     : "x * n(y) * L = x * bot \<squnion> n(x * y) * L" (* nitpick [expect=genuine,card=4] *) oops
proposition n_split       : "x \<le> x * bot \<squnion> n(x * L) * top" (* nitpick [expect=genuine,card=3] *) oops

end

typedef (overloaded) 'a nImage = "{ x::'a::n_semiring . (\<exists>y::'a . x = n(y)) }"
  by auto

lemma simp_nImage[simp]:
  "\<exists>y . Rep_nImage x = n(y)"
  using Rep_nImage by simp

setup_lifting type_definition_nImage

text \<open>Theorem 15\<close>

instantiation nImage :: (n_semiring) bounded_idempotent_semiring
begin

lift_definition sup_nImage :: "'a nImage \<Rightarrow> 'a nImage \<Rightarrow> 'a nImage" is sup
  by (metis n_dist_sup)

lift_definition times_nImage :: "'a nImage \<Rightarrow> 'a nImage \<Rightarrow> 'a nImage" is times
  by (metis n_export)

lift_definition bot_nImage :: "'a nImage" is bot
  by (metis n_bot)

lift_definition one_nImage :: "'a nImage" is 1
  using n_L by auto

lift_definition top_nImage :: "'a nImage" is 1
  using n_L by auto

lift_definition less_eq_nImage :: "'a nImage \<Rightarrow> 'a nImage \<Rightarrow> bool" is less_eq .

lift_definition less_nImage :: "'a nImage \<Rightarrow> 'a nImage \<Rightarrow> bool" is less .

instance
  apply intro_classes
  apply (simp add: less_eq_nImage.rep_eq less_le_not_le less_nImage.rep_eq)
  apply (simp add: less_eq_nImage.rep_eq)
  using less_eq_nImage.rep_eq apply force
  apply (simp add: less_eq_nImage.rep_eq Rep_nImage_inject)
  apply (simp add: sup_nImage.rep_eq less_eq_nImage.rep_eq)
  apply (simp add: less_eq_nImage.rep_eq sup_nImage.rep_eq)
  apply (simp add: sup_nImage.rep_eq less_eq_nImage.rep_eq)
  apply (simp add: bot_nImage.rep_eq less_eq_nImage.rep_eq)
  apply (simp add: sup_nImage.rep_eq times_nImage.rep_eq less_eq_nImage.rep_eq mult_left_dist_sup)
  apply (metis (mono_tags, lifting) sup_nImage.rep_eq times_nImage.rep_eq Rep_nImage_inverse mult_right_dist_sup)
  apply (smt (z3) times_nImage.rep_eq Rep_nImage_inverse bot_nImage.rep_eq mult_left_zero)
  using Rep_nImage_inject one_nImage.rep_eq times_nImage.rep_eq apply fastforce
  apply (simp add: one_nImage.rep_eq times_nImage.rep_eq less_eq_nImage.rep_eq)
  apply (smt (verit, del_insts) sup_nImage.rep_eq Rep_nImage Rep_nImage_inject mem_Collect_eq n_sub_one sup.absorb2 top_nImage.rep_eq)
  apply (simp add: less_eq_nImage.rep_eq mult.assoc times_nImage.rep_eq)
  using Rep_nImage_inject mult.assoc times_nImage.rep_eq apply fastforce
  using Rep_nImage_inject one_nImage.rep_eq times_nImage.rep_eq apply fastforce
  apply (metis (mono_tags, lifting) sup_nImage.rep_eq times_nImage.rep_eq Rep_nImage_inject mult_left_dist_sup)
  by (smt (z3) Rep_nImage_inject bot_nImage.rep_eq n_mult_right_bot simp_nImage times_nImage.rep_eq)

end

text \<open>Theorem 15\<close>

instantiation nImage :: (n_semiring) bounded_distrib_lattice
begin

lift_definition inf_nImage :: "'a nImage \<Rightarrow> 'a nImage \<Rightarrow> 'a nImage" is times
  by (metis n_export)

instance
  apply intro_classes
  apply (metis (mono_tags) inf_nImage.rep_eq less_eq_nImage.rep_eq n_mult_left_lower_bound simp_nImage)
  apply (metis (mono_tags) inf_nImage.rep_eq less_eq_nImage.rep_eq n_mult_right_lower_bound simp_nImage)
  apply (smt (z3) inf_nImage_def le_iff_sup less_eq_nImage.rep_eq mult_right_dist_sup n_mult_left_absorb_sup simp_nImage times_nImage.rep_eq times_nImage_def)
  apply simp
  by (smt (z3) Rep_nImage_inject inf_nImage.rep_eq n_sup_right_dist_mult simp_nImage sup.commute sup_nImage.rep_eq)

end

class n_itering = bounded_itering + n_semiring
begin

lemma mult_L_circ:
  "(x * L)\<^sup>\<circ> = 1 \<squnion> x * L"
  by (metis L_left_zero circ_mult mult_assoc)

lemma mult_L_circ_mult:
  "(x * L)\<^sup>\<circ> * y = y \<squnion> x * L"
  by (metis L_left_zero mult_L_circ mult_assoc mult_left_one mult_right_dist_sup)

lemma circ_L:
  "L\<^sup>\<circ> = L \<squnion> 1"
  by (metis L_left_zero sup_commute circ_left_unfold)

lemma circ_n_L:
  "x\<^sup>\<circ> * n(x) * L = x\<^sup>\<circ> * bot"
  by (metis sup_bot_left circ_left_unfold circ_plus_same mult_left_zero n_L_split n_dist_sup n_mult_bot n_one ni_def ni_split)

lemma n_circ_left_unfold:
  "n(x\<^sup>\<circ>) = n(x * x\<^sup>\<circ>)"
  by (metis circ_n_L circ_plus_same n_mult n_mult_bot)

lemma ni_circ:
  "ni(x)\<^sup>\<circ> = 1 \<squnion> ni(x)"
  by (simp add: mult_L_circ ni_def)

lemma circ_ni:
  "x\<^sup>\<circ> * ni(x) = x\<^sup>\<circ> * bot"
  using circ_n_L ni_def mult_assoc by auto

lemma ni_circ_left_unfold:
  "ni(x\<^sup>\<circ>) = ni(x * x\<^sup>\<circ>)"
  by (simp add: ni_def n_circ_left_unfold)

lemma n_circ_import:
  "n(y) * x \<le> x * n(y) \<Longrightarrow> n(y) * x\<^sup>\<circ> = n(y) * (n(y) * x)\<^sup>\<circ>"
  by (simp add: circ_import n_mult_idempotent n_sub_one)

end

class n_omega_itering = left_omega_conway_semiring + n_itering +
  assumes circ_circ: "x\<^sup>\<circ>\<^sup>\<circ> = L \<squnion> x\<^sup>\<star>"
begin

lemma L_below_one_circ:
  "L \<le> 1\<^sup>\<circ>"
  by (metis sup_left_divisibility circ_circ circ_one)

lemma circ_below_L_sup_star:
  "x\<^sup>\<circ> \<le> L \<squnion> x\<^sup>\<star>"
  by (metis circ_circ circ_increasing)

lemma L_sup_circ_sup_star:
  "L \<squnion> x\<^sup>\<circ> = L \<squnion> x\<^sup>\<star>"
  by (metis circ_circ circ_star star_circ)

lemma circ_one_L:
  "1\<^sup>\<circ> = L \<squnion> 1"
  using circ_circ circ_one star_one by auto

lemma one_circ_zero:
  "L = 1\<^sup>\<circ> * bot"
  by (metis L_left_zero circ_L circ_ni circ_one_L circ_plus_same ni_L)

lemma circ_not_simulate:
  "(\<forall>x y z . x * z \<le> z * y \<longrightarrow> x\<^sup>\<circ> * z \<le> z * y\<^sup>\<circ>) \<longrightarrow> 1 = bot"
  by (metis L_left_zero circ_one_L order.eq_iff mult_left_one mult_left_zero mult_right_sub_dist_sup_left n_L n_bot bot_least)

lemma star_circ_L:
  "x\<^sup>\<star>\<^sup>\<circ> = L \<squnion> x\<^sup>\<star>"
  by (simp add: circ_circ star_circ)

lemma circ_circ_2:
  "x\<^sup>\<circ>\<^sup>\<circ> = L \<squnion> x\<^sup>\<circ>"
  by (simp add: L_sup_circ_sup_star circ_circ)

lemma circ_sup_6:
  "L \<squnion> (x \<squnion> y)\<^sup>\<circ> = (x\<^sup>\<circ> * y\<^sup>\<circ>)\<^sup>\<circ>"
  by (metis circ_circ_2 sup_assoc sup_commute circ_sup_1 circ_circ_sup circ_decompose_4)

lemma circ_sup_7:
  "(x\<^sup>\<circ> * y\<^sup>\<circ>)\<^sup>\<circ> = L \<squnion> (x \<squnion> y)\<^sup>\<star>"
  using L_sup_circ_sup_star circ_sup_6 by auto

end

class n_omega_algebra_2 = bounded_left_zero_omega_algebra + n_semiring + Omega +
  assumes Omega_def: "x\<^sup>\<Omega> = n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star>"
begin

lemma mult_L_star:
  "(x * L)\<^sup>\<star> = 1 \<squnion> x * L"
  by (simp add: L_left_zero transitive_star mult_assoc)

lemma mult_L_omega:
  "(x * L)\<^sup>\<omega> = x * L"
  by (metis L_left_zero omega_slide)

lemma mult_L_sup_star:
  "(x * L \<squnion> y)\<^sup>\<star> = y\<^sup>\<star> \<squnion> y\<^sup>\<star> * x * L"
  by (metis L_left_zero star.mult_zero_sup_circ_2 sup_commute mult_assoc)

lemma mult_L_sup_omega:
  "(x * L \<squnion> y)\<^sup>\<omega> = y\<^sup>\<omega> \<squnion> y\<^sup>\<star> * x * L"
  by (metis L_left_zero mult_bot_add_omega sup_commute mult_assoc)

lemma mult_L_sup_circ:
  "(x * L \<squnion> y)\<^sup>\<Omega> = n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> \<squnion> y\<^sup>\<star> * x * L"
  by (smt sup_assoc sup_commute Omega_def le_iff_sup mult_L_sup_omega mult_L_sup_star mult_right_dist_sup n_L_decreasing n_dist_sup)

lemma circ_sup_n:
  "(x\<^sup>\<Omega> * y)\<^sup>\<Omega> * x\<^sup>\<Omega> = n((x\<^sup>\<star> * y)\<^sup>\<omega>) * L \<squnion> ((x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<star> \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * n(x\<^sup>\<omega>) * L)"
  by (smt L_left_zero sup_assoc sup_commute Omega_def mult_L_sup_circ mult_assoc mult_left_dist_sup mult_right_dist_sup)

text \<open>Theorem 20.6\<close>

lemma n_omega_induct:
  "n(y) \<le> n(x * y \<squnion> z) \<Longrightarrow> n(y) \<le> n(x\<^sup>\<omega> \<squnion> x\<^sup>\<star> * z)"
  by (smt sup_commute mult_assoc n_dist_sup n_galois n_mult omega_induct)

lemma n_Omega_left_unfold:
  "1 \<squnion> x * x\<^sup>\<Omega> = x\<^sup>\<Omega>"
proof -
  have "1 \<squnion> x * x\<^sup>\<Omega> = 1 \<squnion> x * n(x\<^sup>\<omega>) * L \<squnion> x * x\<^sup>\<star>"
    by (simp add: Omega_def semiring.distrib_left sup_assoc mult_assoc)
  also have "... = n(x * x\<^sup>\<omega>) * L \<squnion> (1 \<squnion> x * x\<^sup>\<star>)"
    by (metis sup_assoc sup_commute sup_bot_left mult_left_dist_sup n_L_split)
  also have "... = n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star>"
    using omega_unfold star_left_unfold_equal by auto
  also have "... = x\<^sup>\<Omega>"
    by (simp add: Omega_def)
  finally show ?thesis
    .
qed

lemma n_Omega_circ_sup:
  "(x \<squnion> y)\<^sup>\<Omega> = (x\<^sup>\<Omega> * y)\<^sup>\<Omega> * x\<^sup>\<Omega>"
proof -
  have "(x\<^sup>\<Omega> * y)\<^sup>\<Omega> * x\<^sup>\<Omega> = n((x\<^sup>\<star> * y)\<^sup>\<omega>) * L \<squnion> ((x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<star> \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * n(x\<^sup>\<omega>) * L)"
    by (simp add: circ_sup_n)
  also have "... = n((x\<^sup>\<star> * y)\<^sup>\<omega>) * L \<squnion> n((x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<omega>) * L \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * bot \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<star>"
    using n_L_split sup.left_commute sup_commute by auto
  also have "... = n((x\<^sup>\<star> * y)\<^sup>\<omega> \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<omega>) * L \<squnion> (x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<star>"
    by (smt sup_assoc sup_bot_left mult_left_dist_sup mult_right_dist_sup n_dist_sup)
  also have "... = (x \<squnion> y)\<^sup>\<Omega>"
    by (simp add: Omega_def omega_decompose star.circ_sup_9)
  finally show ?thesis
    ..
qed

lemma n_Omega_circ_simulate_right_sup:
  assumes "z * x \<le> y * y\<^sup>\<Omega> * z \<squnion> w"
    shows "z * x\<^sup>\<Omega> \<le> y\<^sup>\<Omega> * (z \<squnion> w * x\<^sup>\<Omega>)"
proof -
  have "z * x \<le> y * y\<^sup>\<Omega> * z \<squnion> w"
    by (simp add: assms)
  also have "... = y * n(y\<^sup>\<omega>) * L \<squnion> y * y\<^sup>\<star> * z \<squnion> w"
    using L_left_zero Omega_def mult_right_dist_sup semiring.distrib_left mult_assoc by auto
  finally have 1: "z * x \<le> n(y\<^sup>\<omega>) * L \<squnion> y * y\<^sup>\<star> * z \<squnion> w"
    by (metis sup_assoc sup_commute sup_bot_left mult_assoc mult_left_dist_sup n_L_split omega_unfold)
  hence "(n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>) * x \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * (n(y\<^sup>\<omega>) * L \<squnion> y * y\<^sup>\<star> * z \<squnion> w) \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    by (smt L_left_zero sup_assoc sup_ge1 sup_ge2 le_iff_sup mult_assoc mult_left_dist_sup mult_right_dist_sup star.circ_back_loop_fixpoint)
  also have "... = n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * y * y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    using semiring.distrib_left sup_assoc mult_assoc by auto
  also have "... = n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * y * y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    by (smt (verit, ccfv_SIG) le_supI1 order.refl semiring.add_mono star.circ_back_loop_prefixpoint sup.bounded_iff sup.coboundedI1 sup.mono sup_left_divisibility sup_right_divisibility sup_same_context)
  also have "... = n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * y * y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    by (smt sup_assoc sup_commute sup_idem mult_assoc mult_left_dist_sup n_L_split star_mult_omega)
  also have "... \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    by (meson mult_left_isotone order_refl semiring.add_left_mono star.circ_mult_upper_bound star.right_plus_below_circ sup_left_isotone)
  finally have 2: "z * x\<^sup>\<star> \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    by (smt le_supI1 le_sup_iff sup_ge1 star.circ_loop_fixpoint star_right_induct)
  have "z * x * x\<^sup>\<omega> \<le> n(y\<^sup>\<omega>) * L \<squnion> y * y\<^sup>\<star> * z * x\<^sup>\<omega> \<squnion> w * x\<^sup>\<omega>"
    using 1 by (smt (verit, del_insts) L_left_zero mult_assoc mult_left_isotone mult_right_dist_sup)
  hence "n(z * x * x\<^sup>\<omega>) \<le> n(y * y\<^sup>\<star> * z * x\<^sup>\<omega> \<squnion> n(y\<^sup>\<omega>) * L \<squnion> w * x\<^sup>\<omega>)"
    by (simp add: n_isotone sup_commute)
  hence "n(z * x\<^sup>\<omega>) \<le> n(y\<^sup>\<omega> \<squnion> y\<^sup>\<star> * w * x\<^sup>\<omega>)"
    by (smt (verit, del_insts) sup_assoc sup_commute left_plus_omega le_iff_sup mult_assoc mult_left_dist_sup n_L_decreasing n_omega_induct omega_unfold star.left_plus_circ star_mult_omega)
  hence "n(z * x\<^sup>\<omega>) * L \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L"
    by (metis n_dist_sup n_galois n_mult n_n_L)
  hence "z * n(x\<^sup>\<omega>) * L \<le> z * bot \<squnion> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L"
    using n_L_split semiring.add_left_mono sup_assoc by auto
  also have "... \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L"
    by (smt (z3) order.trans mult_1_left mult_right_sub_dist_sup_left semiring.add_right_mono star_left_unfold_equal sup_commute zero_right_mult_decreasing)
  finally have "z * n(x\<^sup>\<omega>) * L \<le> n(y\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * z \<squnion> y\<^sup>\<star> * w * n(x\<^sup>\<omega>) * L \<squnion> y\<^sup>\<star> * w * x\<^sup>\<star>"
    using le_supI1 by blast
  thus ?thesis
    using 2 by (smt L_left_zero Omega_def sup_assoc le_iff_sup mult_assoc mult_left_dist_sup mult_right_dist_sup)
qed

lemma n_Omega_circ_simulate_left_sup:
  assumes "x * z \<le> z * y\<^sup>\<Omega> \<squnion> w"
    shows "x\<^sup>\<Omega> * z \<le> (z \<squnion> x\<^sup>\<Omega> * w) * y\<^sup>\<Omega>"
proof -
  have "x * (z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>) = x * z * n(y\<^sup>\<omega>) * L \<squnion> x * z * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x * x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x * x\<^sup>\<star> * w * y\<^sup>\<star>"
    by (smt sup_assoc sup_commute mult_assoc mult_left_dist_sup n_L_split omega_unfold)
  also have "... \<le> (z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> w) * n(y\<^sup>\<omega>) * L \<squnion> (z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> w) * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>"
    by (smt assms Omega_def sup_assoc sup_ge2 le_iff_sup mult_assoc mult_left_dist_sup mult_right_dist_sup star.circ_loop_fixpoint)
  also have "... = z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> * n(y\<^sup>\<omega>) * L \<squnion> w * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> w * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>"
    by (smt L_left_zero sup_assoc sup_commute sup_idem mult_assoc mult_right_dist_sup star.circ_transitive_equal)
  also have "... = z * n(y\<^sup>\<omega>) * L \<squnion> w * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> w * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>"
    by (smt sup_assoc sup_commute sup_idem le_iff_sup mult_assoc n_L_split star_mult_omega zero_right_mult_decreasing)
  finally have "x * (z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>) \<le> z * n(y\<^sup>\<omega>) * L \<squnion> z * y\<^sup>\<star> \<squnion> n(x\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * n(y\<^sup>\<omega>) * L \<squnion> x\<^sup>\<star> * w * y\<^sup>\<star>"
    by (smt sup_assoc sup_commute sup_idem mult_assoc star.circ_loop_fixpoint)
  thus "x\<^sup>\<Omega> * z \<le> (z \<squnion> x\<^sup>\<Omega> * w) * y\<^sup>\<Omega>"
    by (smt (verit, del_insts) L_left_zero Omega_def sup_assoc le_supI1 le_sup_iff sup_ge1 mult_assoc mult_left_dist_sup mult_right_dist_sup star.circ_back_loop_fixpoint star_left_induct)
qed

end

text \<open>Theorem 2.6 and Theorem 19\<close>

sublocale n_omega_algebra_2 < nL_omega: itering where circ = Omega
  apply unfold_locales
  apply (simp add: n_Omega_circ_sup)
  apply (smt L_left_zero sup_assoc sup_commute sup_bot_left Omega_def mult_assoc mult_left_dist_sup mult_right_dist_sup n_L_split omega_slide star.circ_mult)
  apply (simp add: n_Omega_circ_simulate_right_sup)
  using n_Omega_circ_simulate_left_sup by auto

sublocale n_omega_algebra_2 < nL_omega: n_omega_itering where circ = Omega
  apply unfold_locales
  by (smt Omega_def sup_assoc sup_commute le_iff_sup mult_L_sup_star mult_left_one n_L_split n_top ni_below_L ni_def star_involutive star_mult_omega star_omega_top zero_right_mult_decreasing)

sublocale n_omega_algebra_2 < nL_omega: left_zero_kleene_conway_semiring where circ = Omega ..

sublocale n_omega_algebra_2 < nL_star: left_omega_conway_semiring where circ = star ..

context n_omega_algebra_2
begin

lemma circ_sup_8:
  "n((x\<^sup>\<star> * y)\<^sup>\<star> * x\<^sup>\<omega>) * L \<le> (x\<^sup>\<star> * y)\<^sup>\<Omega> * x\<^sup>\<Omega>"
  by (metis sup_ge1 nL_omega.circ_sup_4 Omega_def mult_left_isotone n_isotone omega_sum_unfold_3 order_trans)

lemma n_split_omega_omega:
  "x\<^sup>\<omega> \<le> x\<^sup>\<omega> * bot \<squnion> n(x\<^sup>\<omega>) * top"
  by (metis n_split n_top_L omega_vector)

text \<open>Theorem 20.1\<close>

lemma n_below_n_star:
  "n(x) \<le> n(x\<^sup>\<star>)"
  by (simp add: n_isotone star.circ_increasing)

text \<open>Theorem 20.2\<close>

lemma n_star_below_n_omega:
  "n(x\<^sup>\<star>) \<le> n(x\<^sup>\<omega>)"
  by (metis n_mult_left_upper_bound star_mult_omega)

lemma n_below_n_omega:
  "n(x) \<le> n(x\<^sup>\<omega>)"
  using order.trans n_below_n_star n_star_below_n_omega by blast

text \<open>Theorem 20.4\<close>

lemma star_n_L:
  "x\<^sup>\<star> * n(x) * L = x\<^sup>\<star> * bot"
  by (metis sup_bot_left mult_left_zero n_L_split n_dist_sup n_mult_bot n_one ni_def ni_split star_left_unfold_equal star_plus)

lemma star_L_split:
  assumes "y \<le> z"
      and "x * z * L \<le> x * bot \<squnion> z * L"
    shows "x\<^sup>\<star> * y * L \<le> x\<^sup>\<star> * bot \<squnion> z * L"
proof -
  have "x * (x\<^sup>\<star> * bot \<squnion> z * L) \<le> x\<^sup>\<star> * bot \<squnion> x * z * L"
    by (metis sup_bot_right order.eq_iff mult_assoc mult_left_dist_sup star.circ_loop_fixpoint)
  also have "... \<le> x\<^sup>\<star> * bot \<squnion> x * bot \<squnion> z * L"
    using assms(2) semiring.add_left_mono sup_assoc by auto
  also have "... = x\<^sup>\<star> * bot \<squnion> z * L"
    using mult_left_isotone star.circ_increasing sup.absorb_iff2 sup_commute by auto
  finally have "y * L \<squnion> x * (x\<^sup>\<star> * bot \<squnion> z * L) \<le> x\<^sup>\<star> * bot \<squnion> z * L"
    by (metis assms(1) le_sup_iff sup_ge2 mult_left_isotone order_trans)
  thus ?thesis
    by (simp add: star_left_induct mult_assoc)
qed

lemma star_L_split_same:
  "x * y * L \<le> x * bot \<squnion> y * L \<Longrightarrow> x\<^sup>\<star> * y * L = x\<^sup>\<star> * bot \<squnion> y * L"
  apply (rule order.antisym)
  apply (simp add: star_L_split)
  by (metis bot_least le_supI mult_isotone nL_star.star_below_circ star.circ_loop_fixpoint sup.cobounded2 mult_assoc)

lemma star_n_L_split_equal:
  "n(x * y) \<le> n(y) \<Longrightarrow> x\<^sup>\<star> * n(y) * L = x\<^sup>\<star> * bot \<squnion> n(y) * L"
  by (simp add: n_mult_right_upper_bound star_L_split_same)

lemma n_star_mult:
  "n(x * y) \<le> n(y) \<Longrightarrow> n(x\<^sup>\<star> * y) = n(x\<^sup>\<star>) \<squnion> n(y)"
  by (metis n_dist_sup n_mult n_mult_bot n_n_L star_n_L_split_equal)

text \<open>Theorem 20.3\<close>

lemma n_omega_mult:
  "n(x\<^sup>\<omega> * y) = n(x\<^sup>\<omega>)"
  by (simp add: n_isotone n_mult_left_upper_bound omega_sub_vector order.eq_iff)

lemma n_star_left_unfold:
  "n(x\<^sup>\<star>) = n(x * x\<^sup>\<star>)"
  by (metis n_mult n_mult_bot star.circ_plus_same star_n_L)

lemma ni_star_below_ni_omega:
  "ni(x\<^sup>\<star>) \<le> ni(x\<^sup>\<omega>)"
  by (simp add: ni_n_order n_star_below_n_omega)

lemma ni_below_ni_omega:
  "ni(x) \<le> ni(x\<^sup>\<omega>)"
  by (simp add: ni_n_order n_below_n_omega)

lemma ni_star:
  "ni(x)\<^sup>\<star> = 1 \<squnion> ni(x)"
  by (simp add: mult_L_star ni_def)

lemma ni_omega:
  "ni(x)\<^sup>\<omega> = ni(x)"
  using mult_L_omega ni_def by auto

lemma ni_omega_induct:
  "ni(y) \<le> ni(x * y \<squnion> z) \<Longrightarrow> ni(y) \<le> ni(x\<^sup>\<omega> \<squnion> x\<^sup>\<star> * z)"
  using n_omega_induct ni_n_order by blast

lemma star_ni:
  "x\<^sup>\<star> * ni(x) = x\<^sup>\<star> * bot"
  using ni_def mult_assoc star_n_L by auto

lemma star_ni_split_equal:
  "ni(x * y) \<le> ni(y) \<Longrightarrow> x\<^sup>\<star> * ni(y) = x\<^sup>\<star> * bot \<squnion> ni(y)"
  using ni_def ni_mult_right_upper_bound mult_assoc star_L_split_same by auto

lemma ni_star_mult:
  "ni(x * y) \<le> ni(y) \<Longrightarrow> ni(x\<^sup>\<star> * y) = ni(x\<^sup>\<star>) \<squnion> ni(y)"
  using mult_right_dist_sup ni_def ni_n_order n_star_mult by auto

lemma ni_omega_mult:
  "ni(x\<^sup>\<omega> * y) = ni(x\<^sup>\<omega>)"
  by (simp add: ni_def n_omega_mult)

lemma ni_star_left_unfold:
  "ni(x\<^sup>\<star>) = ni(x * x\<^sup>\<star>)"
  by (simp add: ni_def n_star_left_unfold)

lemma n_star_import:
  assumes "n(y) * x \<le> x * n(y)"
    shows "n(y) * x\<^sup>\<star> = n(y) * (n(y) * x)\<^sup>\<star>"
proof (rule order.antisym)
  have "n(y) * (n(y) * x)\<^sup>\<star> * x \<le> n(y) * (n(y) * x)\<^sup>\<star>"
    by (smt assms mult_assoc mult_right_dist_sup mult_right_sub_dist_sup_left n_mult_idempotent n_preserves_equation star.circ_back_loop_fixpoint)
  thus "n(y) * x\<^sup>\<star> \<le> n(y) * (n(y) * x)\<^sup>\<star>"
    using assms eq_refl n_mult_idempotent n_sub_one star.circ_import by auto
next
  show "n(y) * (n(y) * x)\<^sup>\<star> \<le> n(y) * x\<^sup>\<star>"
    by (simp add: assms n_mult_idempotent n_sub_one star.circ_import)
qed

lemma n_omega_export:
  "n(y) * x \<le> x * n(y) \<Longrightarrow> n(y) * x\<^sup>\<omega> = (n(y) * x)\<^sup>\<omega>"
  apply (rule order.antisym)
  apply (simp add: n_preserves_equation omega_simulation)
  by (metis mult_right_isotone mult_1_right n_sub_one omega_isotone omega_slide)

lemma n_omega_import:
  "n(y) * x \<le> x * n(y) \<Longrightarrow> n(y) * x\<^sup>\<omega> = n(y) * (n(y) * x)\<^sup>\<omega>"
  by (simp add: n_mult_idempotent omega_import)

text \<open>Theorem 20.5\<close>

lemma star_n_omega_top:
  "x\<^sup>\<star> * n(x\<^sup>\<omega>) * top = x\<^sup>\<star> * bot \<squnion> n(x\<^sup>\<omega>) * top"
  by (smt (verit, del_insts) le_supI le_sup_iff sup_right_divisibility order.antisym mult_assoc nL_star.circ_mult_omega nL_star.star_zero_below_circ_mult n_top_split star.circ_loop_fixpoint)

proposition n_star_induct_sup: "n(z \<squnion> x * y) \<le> n(y) \<Longrightarrow> n(x\<^sup>\<star> * z) \<le> n(y)" oops

end

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

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

datatype Nat = Z | S "Nat"

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

fun x :: "Nat => Nat => bool" where
  "x (Z) (Z) = True"
| "x (Z) (S z2) = False"
| "x (S x2) (Z) = False"
| "x (S x2) (S y22) = x x2 y22"

fun elem :: "Nat => Nat list => bool" where
  "elem z (nil2) = False"
| "elem z (cons2 z2 xs) = (if x z z2 then True else elem z xs)"

theorem property0 :
  "((elem z ys) ==> (elem z (y xs ys)))"
  oops

end


theory Elimination
  imports Main
begin

text \<open> In classical propositional logic, the connectives @{text "=, \<or>,
\<not>"} can be replaced by @{text "\<longrightarrow>, \<and>, False"}.  Define
corresponding simplification rules as lemmas and prove their correctness.  (You
may use automated proof tactics.) \<close>

lemma iff_rewrite:"(A = B) = ((A \<longrightarrow> B) \<and> (B \<longrightarrow> A))"
  by blast

lemma demorgan:"(A \<or> B) = (\<not>(\<not>A \<and> \<not>B))"
  by blast

lemma false_rewrite:"(\<not>A) = (A \<longrightarrow> False)"
  by blast

text \<open> What is the result of your translation for the formula @{text "A \<or>
(B \<and> C) = A"}?  (You can use Isabelle's simplifier to compute the result
by using the simplifier's @{text "only"} option.) \<close>

lemma "(A \<or> (B \<and> C) = A)"
  apply (simp only: iff_rewrite demorgan false_rewrite)
  oops

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

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

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

theorem property0 :
  "((dropWhile (% (x :: 'a) => False) xs) = xs)"
  (*Why induciton on "xs" rather than on "x"?
    Because "dropWhile" pattern-matches on the second parameter.*)
  find_proof DInd
  apply (induct xs)(*xs is optional*)
   apply auto
  done

end


(*  Title:      ZF/Induct/Multiset.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory

A definitional theory of multisets,
including a wellfoundedness proof for the multiset order.

The theory features ordinal multisets and the usual ordering.
*)

theory Multiset
imports FoldSet Acc
begin

abbreviation (input)
  \<comment> \<open>Short cut for multiset space\<close>
  Mult :: "i=>i" where
  "Mult(A) == A -||> nat-{0}"

definition
  (* This is the original "restrict" from ZF.thy.
     Restricts the function f to the domain A
     FIXME: adapt Multiset to the new "restrict". *)
  funrestrict :: "[i,i] => i"  where
  "funrestrict(f,A) == \<lambda>x \<in> A. f`x"

definition
  (* M is a multiset *)
  multiset :: "i => o"  where
  "multiset(M) == \<exists>A. M \<in> A -> nat-{0} & Finite(A)"

definition
  mset_of :: "i=>i"  where
  "mset_of(M) == domain(M)"

definition
  munion    :: "[i, i] => i" (infixl \<open>+#\<close> 65)  where
  "M +# N == \<lambda>x \<in> mset_of(M) \<union> mset_of(N).
     if x \<in> mset_of(M) \<inter> mset_of(N) then  (M`x) #+ (N`x)
     else (if x \<in> mset_of(M) then M`x else N`x)"

definition
  (*convert a function to a multiset by eliminating 0*)
  normalize :: "i => i"  where
  "normalize(f) ==
       if (\<exists>A. f \<in> A -> nat & Finite(A)) then
            funrestrict(f, {x \<in> mset_of(f). 0 < f`x})
       else 0"

definition
  mdiff  :: "[i, i] => i" (infixl \<open>-#\<close> 65)  where
  "M -# N ==  normalize(\<lambda>x \<in> mset_of(M).
                        if x \<in> mset_of(N) then M`x #- N`x else M`x)"

definition
  (* set of elements of a multiset *)
  msingle :: "i => i"    (\<open>{#_#}\<close>)  where
  "{#a#} == {<a, 1>}"

definition
  MCollect :: "[i, i=>o] => i"  (*comprehension*)  where
  "MCollect(M, P) == funrestrict(M, {x \<in> mset_of(M). P(x)})"

definition
  (* Counts the number of occurrences of an element in a multiset *)
  mcount :: "[i, i] => i"  where
  "mcount(M, a) == if a \<in> mset_of(M) then  M`a else 0"

definition
  msize :: "i => i"  where
  "msize(M) == setsum(%a. $# mcount(M,a), mset_of(M))"

abbreviation
  melem :: "[i,i] => o"    (\<open>(_/ :# _)\<close> [50, 51] 50)  where
  "a :# M == a \<in> mset_of(M)"

syntax
  "_MColl" :: "[pttrn, i, o] => i" (\<open>(1{# _ \<in> _./ _#})\<close>)
translations
  "{#x \<in> M. P#}" == "CONST MCollect(M, \<lambda>x. P)"

  (* multiset orderings *)

definition
   (* multirel1 has to be a set (not a predicate) so that we can form
      its transitive closure and reason about wf(.) and acc(.) *)
  multirel1 :: "[i,i]=>i"  where
  "multirel1(A, r) ==
     {<M, N> \<in> Mult(A)*Mult(A).
      \<exists>a \<in> A. \<exists>M0 \<in> Mult(A). \<exists>K \<in> Mult(A).
      N=M0 +# {#a#} & M=M0 +# K & (\<forall>b \<in> mset_of(K). <b,a> \<in> r)}"

definition
  multirel :: "[i, i] => i"  where
  "multirel(A, r) == multirel1(A, r)^+"

  (* ordinal multiset orderings *)

definition
  omultiset :: "i => o"  where
  "omultiset(M) == \<exists>i. Ord(i) & M \<in> Mult(field(Memrel(i)))"

definition
  mless :: "[i, i] => o" (infixl \<open><#\<close> 50)  where
  "M <# N ==  \<exists>i. Ord(i) & <M, N> \<in> multirel(field(Memrel(i)), Memrel(i))"

definition
  mle  :: "[i, i] => o"  (infixl \<open><#=\<close> 50)  where
  "M <#= N == (omultiset(M) & M = N) | M <# N"

subsection\<open>Properties of the original "restrict" from ZF.thy\<close>

lemma funrestrict_subset: "[| f \<in> Pi(C,B);  A\<subseteq>C |] ==> funrestrict(f,A) \<subseteq> f"
by (auto simp add: funrestrict_def lam_def intro: apply_Pair)

lemma funrestrict_type:
    "[| !!x. x \<in> A ==> f`x \<in> B(x) |] ==> funrestrict(f,A) \<in> Pi(A,B)"
by (simp add: funrestrict_def lam_type)

lemma funrestrict_type2: "[| f \<in> Pi(C,B);  A\<subseteq>C |] ==> funrestrict(f,A) \<in> Pi(A,B)"
by (blast intro: apply_type funrestrict_type)

lemma funrestrict [simp]: "a \<in> A ==> funrestrict(f,A) ` a = f`a"
by (simp add: funrestrict_def)

lemma funrestrict_empty [simp]: "funrestrict(f,0) = 0"
by (simp add: funrestrict_def)

lemma domain_funrestrict [simp]: "domain(funrestrict(f,C)) = C"
by (auto simp add: funrestrict_def lam_def)

lemma fun_cons_funrestrict_eq:
     "f \<in> cons(a, b) -> B ==> f = cons(<a, f ` a>, funrestrict(f, b))"
apply (rule equalityI)
prefer 2 apply (blast intro: apply_Pair funrestrict_subset [THEN subsetD])
apply (auto dest!: Pi_memberD simp add: funrestrict_def lam_def)
done

declare domain_of_fun [simp]
declare domainE [rule del]

text\<open>A useful simplification rule\<close>
lemma multiset_fun_iff:
     "(f \<in> A -> nat-{0}) \<longleftrightarrow> f \<in> A->nat&(\<forall>a \<in> A. f`a \<in> nat & 0 < f`a)"
apply safe
apply (rule_tac [4] B1 = "range (f) " in Pi_mono [THEN subsetD])
apply (auto intro!: Ord_0_lt
            dest: apply_type Diff_subset [THEN Pi_mono, THEN subsetD]
            simp add: range_of_fun apply_iff)
done

(** The multiset space  **)
lemma multiset_into_Mult: "[| multiset(M); mset_of(M)\<subseteq>A |] ==> M \<in> Mult(A)"
apply (simp add: multiset_def)
apply (auto simp add: multiset_fun_iff mset_of_def)
apply (rule_tac B1 = "nat-{0}" in FiniteFun_mono [THEN subsetD], simp_all)
apply (rule Finite_into_Fin [THEN [2] Fin_mono [THEN subsetD], THEN fun_FiniteFunI])
apply (simp_all (no_asm_simp) add: multiset_fun_iff)
done

lemma Mult_into_multiset: "M \<in> Mult(A) ==> multiset(M) & mset_of(M)\<subseteq>A"
apply (simp add: multiset_def mset_of_def)
apply (frule FiniteFun_is_fun)
apply (drule FiniteFun_domain_Fin)
apply (frule FinD, clarify)
apply (rule_tac x = "domain (M) " in exI)
apply (blast intro: Fin_into_Finite)
done

lemma Mult_iff_multiset: "M \<in> Mult(A) \<longleftrightarrow> multiset(M) & mset_of(M)\<subseteq>A"
by (blast dest: Mult_into_multiset intro: multiset_into_Mult)

lemma multiset_iff_Mult_mset_of: "multiset(M) \<longleftrightarrow> M \<in> Mult(mset_of(M))"
by (auto simp add: Mult_iff_multiset)

text\<open>The \<^term>\<open>multiset\<close> operator\<close>

(* the empty multiset is 0 *)

lemma multiset_0 [simp]: "multiset(0)"
by (auto intro: FiniteFun.intros simp add: multiset_iff_Mult_mset_of)

text\<open>The \<^term>\<open>mset_of\<close> operator\<close>

lemma multiset_set_of_Finite [simp]: "multiset(M) ==> Finite(mset_of(M))"
by (simp add: multiset_def mset_of_def, auto)

lemma mset_of_0 [iff]: "mset_of(0) = 0"
by (simp add: mset_of_def)

lemma mset_is_0_iff: "multiset(M) ==> mset_of(M)=0 \<longleftrightarrow> M=0"
by (auto simp add: multiset_def mset_of_def)

lemma mset_of_single [iff]: "mset_of({#a#}) = {a}"
by (simp add: msingle_def mset_of_def)

lemma mset_of_union [iff]: "mset_of(M +# N) = mset_of(M) \<union> mset_of(N)"
by (simp add: mset_of_def munion_def)

lemma mset_of_diff [simp]: "mset_of(M)\<subseteq>A ==> mset_of(M -# N) \<subseteq> A"
by (auto simp add: mdiff_def multiset_def normalize_def mset_of_def)

(* msingle *)

lemma msingle_not_0 [iff]: "{#a#} \<noteq> 0 & 0 \<noteq> {#a#}"
by (simp add: msingle_def)

lemma msingle_eq_iff [iff]: "({#a#} = {#b#}) \<longleftrightarrow>  (a = b)"
by (simp add: msingle_def)

lemma msingle_multiset [iff,TC]: "multiset({#a#})"
apply (simp add: multiset_def msingle_def)
apply (rule_tac x = "{a}" in exI)
apply (auto intro: Finite_cons Finite_0 fun_extend3)
done

(** normalize **)

lemmas Collect_Finite = Collect_subset [THEN subset_Finite]

lemma normalize_idem [simp]: "normalize(normalize(f)) = normalize(f)"
apply (simp add: normalize_def funrestrict_def mset_of_def)
apply (case_tac "\<exists>A. f \<in> A -> nat & Finite (A) ")
apply clarify
apply (drule_tac x = "{x \<in> domain (f) . 0 < f ` x}" in spec)
apply auto
apply (auto  intro!: lam_type simp add: Collect_Finite)
done

lemma normalize_multiset [simp]: "multiset(M) ==> normalize(M) = M"
by (auto simp add: multiset_def normalize_def mset_of_def funrestrict_def multiset_fun_iff)

lemma multiset_normalize [simp]: "multiset(normalize(f))"
apply (simp add: normalize_def)
apply (simp add: normalize_def mset_of_def multiset_def, auto)
apply (rule_tac x = "{x \<in> A . 0<f`x}" in exI)
apply (auto intro: Collect_subset [THEN subset_Finite] funrestrict_type)
done

(** Typechecking rules for union and difference of multisets **)

(* union *)

lemma munion_multiset [simp]: "[| multiset(M); multiset(N) |] ==> multiset(M +# N)"
apply (unfold multiset_def munion_def mset_of_def, auto)
apply (rule_tac x = "A \<union> Aa" in exI)
apply (auto intro!: lam_type intro: Finite_Un simp add: multiset_fun_iff zero_less_add)
done

(* difference *)

lemma mdiff_multiset [simp]: "multiset(M -# N)"
by (simp add: mdiff_def)

(** Algebraic properties of multisets **)

(* Union *)

lemma munion_0 [simp]: "multiset(M) ==> M +# 0 = M & 0 +# M = M"
apply (simp add: multiset_def)
apply (auto simp add: munion_def mset_of_def)
done

lemma munion_commute: "M +# N = N +# M"
by (auto intro!: lam_cong simp add: munion_def)

lemma munion_assoc: "(M +# N) +# K = M +# (N +# K)"
apply (unfold munion_def mset_of_def)
apply (rule lam_cong, auto)
done

lemma munion_lcommute: "M +# (N +# K) = N +# (M +# K)"
apply (unfold munion_def mset_of_def)
apply (rule lam_cong, auto)
done

lemmas munion_ac = munion_commute munion_assoc munion_lcommute

(* Difference *)

lemma mdiff_self_eq_0 [simp]: "M -# M = 0"
by (simp add: mdiff_def normalize_def mset_of_def)

lemma mdiff_0 [simp]: "0 -# M = 0"
by (simp add: mdiff_def normalize_def)

lemma mdiff_0_right [simp]: "multiset(M) ==> M -# 0 = M"
by (auto simp add: multiset_def mdiff_def normalize_def multiset_fun_iff mset_of_def funrestrict_def)

lemma mdiff_union_inverse2 [simp]: "multiset(M) ==> M +# {#a#} -# {#a#} = M"
apply (unfold multiset_def munion_def mdiff_def msingle_def normalize_def mset_of_def)
apply (auto cong add: if_cong simp add: ltD multiset_fun_iff funrestrict_def subset_Un_iff2 [THEN iffD1])
prefer 2 apply (force intro!: lam_type)
apply (subgoal_tac [2] "{x \<in> A \<union> {a} . x \<noteq> a \<and> x \<in> A} = A")
apply (rule fun_extension, auto)
apply (drule_tac x = "A \<union> {a}" in spec)
apply (simp add: Finite_Un)
apply (force intro!: lam_type)
done

(** Count of elements **)

lemma mcount_type [simp,TC]: "multiset(M) ==> mcount(M, a) \<in> nat"
by (auto simp add: multiset_def mcount_def mset_of_def multiset_fun_iff)

lemma mcount_0 [simp]: "mcount(0, a) = 0"
by (simp add: mcount_def)

lemma mcount_single [simp]: "mcount({#b#}, a) = (if a=b then 1 else 0)"
by (simp add: mcount_def mset_of_def msingle_def)

lemma mcount_union [simp]: "[| multiset(M); multiset(N) |]
                     ==>  mcount(M +# N, a) = mcount(M, a) #+ mcount (N, a)"
apply (auto simp add: multiset_def multiset_fun_iff mcount_def munion_def mset_of_def)
done

lemma mcount_diff [simp]:
     "multiset(M) ==> mcount(M -# N, a) = mcount(M, a) #- mcount(N, a)"
apply (simp add: multiset_def)
apply (auto dest!: not_lt_imp_le
     simp add: mdiff_def multiset_fun_iff mcount_def normalize_def mset_of_def)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
done

lemma mcount_elem: "[| multiset(M); a \<in> mset_of(M) |] ==> 0 < mcount(M, a)"
apply (simp add: multiset_def, clarify)
apply (simp add: mcount_def mset_of_def)
apply (simp add: multiset_fun_iff)
done

(** msize **)

lemma msize_0 [simp]: "msize(0) = #0"
by (simp add: msize_def)

lemma msize_single [simp]: "msize({#a#}) = #1"
by (simp add: msize_def)

lemma msize_type [simp,TC]: "msize(M) \<in> int"
by (simp add: msize_def)

lemma msize_zpositive: "multiset(M)==> #0 $\<le> msize(M)"
by (auto simp add: msize_def intro: g_zpos_imp_setsum_zpos)

lemma msize_int_of_nat: "multiset(M) ==> \<exists>n \<in> nat. msize(M)= $# n"
apply (rule not_zneg_int_of)
apply (simp_all (no_asm_simp) add: msize_type [THEN znegative_iff_zless_0] not_zless_iff_zle msize_zpositive)
done

lemma not_empty_multiset_imp_exist:
     "[| M\<noteq>0; multiset(M) |] ==> \<exists>a \<in> mset_of(M). 0 < mcount(M, a)"
apply (simp add: multiset_def)
apply (erule not_emptyE)
apply (auto simp add: mset_of_def mcount_def multiset_fun_iff)
apply (blast dest!: fun_is_rel)
done

lemma msize_eq_0_iff: "multiset(M) ==> msize(M)=#0 \<longleftrightarrow> M=0"
apply (simp add: msize_def, auto)
apply (rule_tac P = "setsum (u,v) \<noteq> #0" for u v in swap)
apply blast
apply (drule not_empty_multiset_imp_exist, assumption, clarify)
apply (subgoal_tac "Finite (mset_of (M) - {a}) ")
 prefer 2 apply (simp add: Finite_Diff)
apply (subgoal_tac "setsum (%x. $# mcount (M, x), cons (a, mset_of (M) -{a}))=#0")
 prefer 2 apply (simp add: cons_Diff, simp)
apply (subgoal_tac "#0 $\<le> setsum (%x. $# mcount (M, x), mset_of (M) - {a}) ")
apply (rule_tac [2] g_zpos_imp_setsum_zpos)
apply (auto simp add: Finite_Diff not_zless_iff_zle [THEN iff_sym] znegative_iff_zless_0 [THEN iff_sym])
apply (rule not_zneg_int_of [THEN bexE])
apply (auto simp del: int_of_0 simp add: int_of_add [symmetric] int_of_0 [symmetric])
done

lemma setsum_mcount_Int:
     "Finite(A) ==> setsum(%a. $# mcount(N, a), A \<inter> mset_of(N))
                  = setsum(%a. $# mcount(N, a), A)"
apply (induct rule: Finite_induct)
 apply auto
apply (subgoal_tac "Finite (B \<inter> mset_of (N))")
prefer 2 apply (blast intro: subset_Finite)
apply (auto simp add: mcount_def Int_cons_left)
done

lemma msize_union [simp]:
     "[| multiset(M); multiset(N) |] ==> msize(M +# N) = msize(M) $+ msize(N)"
apply (simp add: msize_def setsum_Un setsum_addf int_of_add setsum_mcount_Int)
apply (subst Int_commute)
apply (simp add: setsum_mcount_Int)
done

lemma msize_eq_succ_imp_elem: "[|msize(M)= $# succ(n); n \<in> nat|] ==> \<exists>a. a \<in> mset_of(M)"
apply (unfold msize_def)
apply (blast dest: setsum_succD)
done

(** Equality of multisets **)

lemma equality_lemma:
     "[| multiset(M); multiset(N); \<forall>a. mcount(M, a)=mcount(N, a) |]
      ==> mset_of(M)=mset_of(N)"
apply (simp add: multiset_def)
apply (rule sym, rule equalityI)
apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
apply (drule_tac [!] x=x in spec)
apply (case_tac [2] "x \<in> Aa", case_tac "x \<in> A", auto)
done

lemma multiset_equality:
  "[| multiset(M); multiset(N) |]==> M=N\<longleftrightarrow>(\<forall>a. mcount(M, a)=mcount(N, a))"
apply auto
apply (subgoal_tac "mset_of (M) = mset_of (N) ")
prefer 2 apply (blast intro: equality_lemma)
apply (simp add: multiset_def mset_of_def)
apply (auto simp add: multiset_fun_iff)
apply (rule fun_extension)
apply (blast, blast)
apply (drule_tac x = x in spec)
apply (auto simp add: mcount_def mset_of_def)
done

(** More algebraic properties of multisets **)

lemma munion_eq_0_iff [simp]: "[|multiset(M); multiset(N)|]==>(M +# N =0) \<longleftrightarrow> (M=0 & N=0)"
by (auto simp add: multiset_equality)

lemma empty_eq_munion_iff [simp]: "[|multiset(M); multiset(N)|]==>(0=M +# N) \<longleftrightarrow> (M=0 & N=0)"
apply (rule iffI, drule sym)
apply (simp_all add: multiset_equality)
done

lemma munion_right_cancel [simp]:
     "[| multiset(M); multiset(N); multiset(K) |]==>(M +# K = N +# K)\<longleftrightarrow>(M=N)"
by (auto simp add: multiset_equality)

lemma munion_left_cancel [simp]:
  "[|multiset(K); multiset(M); multiset(N)|] ==>(K +# M = K +# N) \<longleftrightarrow> (M = N)"
by (auto simp add: multiset_equality)

lemma nat_add_eq_1_cases: "[| m \<in> nat; n \<in> nat |] ==> (m #+ n = 1) \<longleftrightarrow> (m=1 & n=0) | (m=0 & n=1)"
by (induct_tac n) auto

lemma munion_is_single:
     "[|multiset(M); multiset(N)|]
      ==> (M +# N = {#a#}) \<longleftrightarrow>  (M={#a#} & N=0) | (M = 0 & N = {#a#})"
apply (simp (no_asm_simp) add: multiset_equality)
apply safe
apply simp_all
apply (case_tac "aa=a")
apply (drule_tac [2] x = aa in spec)
apply (drule_tac x = a in spec)
apply (simp add: nat_add_eq_1_cases, simp)
apply (case_tac "aaa=aa", simp)
apply (drule_tac x = aa in spec)
apply (simp add: nat_add_eq_1_cases)
apply (case_tac "aaa=a")
apply (drule_tac [4] x = aa in spec)
apply (drule_tac [3] x = a in spec)
apply (drule_tac [2] x = aaa in spec)
apply (drule_tac x = aa in spec)
apply (simp_all add: nat_add_eq_1_cases)
done

lemma msingle_is_union: "[| multiset(M); multiset(N) |]
  ==> ({#a#} = M +# N) \<longleftrightarrow> ({#a#} = M  & N=0 | M = 0 & {#a#} = N)"
apply (subgoal_tac " ({#a#} = M +# N) \<longleftrightarrow> (M +# N = {#a#}) ")
apply (simp (no_asm_simp) add: munion_is_single)
apply blast
apply (blast dest: sym)
done

(** Towards induction over multisets **)

lemma setsum_decr:
"Finite(A)
  ==>  (\<forall>M. multiset(M) \<longrightarrow>
  (\<forall>a \<in> mset_of(M). setsum(%z. $# mcount(M(a:=M`a #- 1), z), A) =
  (if a \<in> A then setsum(%z. $# mcount(M, z), A) $- #1
           else setsum(%z. $# mcount(M, z), A))))"
apply (unfold multiset_def)
apply (erule Finite_induct)
apply (auto simp add: multiset_fun_iff)
apply (unfold mset_of_def mcount_def)
apply (case_tac "x \<in> A", auto)
apply (subgoal_tac "$# M ` x $+ #-1 = $# M ` x $- $# 1")
apply (erule ssubst)
apply (rule int_of_diff, auto)
done

lemma setsum_decr2:
     "Finite(A)
      ==> \<forall>M. multiset(M) \<longrightarrow> (\<forall>a \<in> mset_of(M).
           setsum(%x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A) =
           (if a \<in> A then setsum(%x. $# mcount(M, x), A) $- $# M`a
            else setsum(%x. $# mcount(M, x), A)))"
apply (simp add: multiset_def)
apply (erule Finite_induct)
apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
done

lemma setsum_decr3: "[| Finite(A); multiset(M); a \<in> mset_of(M) |]
      ==> setsum(%x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A - {a}) =
          (if a \<in> A then setsum(%x. $# mcount(M, x), A) $- $# M`a
           else setsum(%x. $# mcount(M, x), A))"
apply (subgoal_tac "setsum (%x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A-{a}) = setsum (%x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A) ")
apply (rule_tac [2] setsum_Diff [symmetric])
apply (rule sym, rule ssubst, blast)
apply (rule sym, drule setsum_decr2, auto)
apply (simp add: mcount_def mset_of_def)
done

lemma nat_le_1_cases: "n \<in> nat ==> n \<le> 1 \<longleftrightarrow> (n=0 | n=1)"
by (auto elim: natE)

lemma succ_pred_eq_self: "[| 0<n; n \<in> nat |] ==> succ(n #- 1) = n"
apply (subgoal_tac "1 \<le> n")
apply (drule add_diff_inverse2, auto)
done

text\<open>Specialized for use in the proof below.\<close>
lemma multiset_funrestict:
     "\<lbrakk>\<forall>a\<in>A. M ` a \<in> nat \<and> 0 < M ` a; Finite(A)\<rbrakk>
      \<Longrightarrow> multiset(funrestrict(M, A - {a}))"
apply (simp add: multiset_def multiset_fun_iff)
apply (rule_tac x="A-{a}" in exI)
apply (auto intro: Finite_Diff funrestrict_type)
done

lemma multiset_induct_aux:
  assumes prem1: "!!M a. [| multiset(M); a\<notin>mset_of(M); P(M) |] ==> P(cons(<a, 1>, M))"
      and prem2: "!!M b. [| multiset(M); b \<in> mset_of(M); P(M) |] ==> P(M(b:= M`b #+ 1))"
  shows
  "[| n \<in> nat; P(0) |]
     ==> (\<forall>M. multiset(M)\<longrightarrow>
  (setsum(%x. $# mcount(M, x), {x \<in> mset_of(M). 0 < M`x}) = $# n) \<longrightarrow> P(M))"
apply (erule nat_induct, clarify)
apply (frule msize_eq_0_iff)
apply (auto simp add: mset_of_def multiset_def multiset_fun_iff msize_def)
apply (subgoal_tac "setsum (%x. $# mcount (M, x), A) =$# succ (x) ")
apply (drule setsum_succD, auto)
apply (case_tac "1 <M`a")
apply (drule_tac [2] not_lt_imp_le)
apply (simp_all add: nat_le_1_cases)
apply (subgoal_tac "M= (M (a:=M`a #- 1)) (a:= (M (a:=M`a #- 1))`a #+ 1) ")
apply (rule_tac [2] A = A and B = "%x. nat" and D = "%x. nat" in fun_extension)
apply (rule_tac [3] update_type)+
apply (simp_all (no_asm_simp))
 apply (rule_tac [2] impI)
 apply (rule_tac [2] succ_pred_eq_self [symmetric])
apply (simp_all (no_asm_simp))
apply (rule subst, rule sym, blast, rule prem2)
apply (simp (no_asm) add: multiset_def multiset_fun_iff)
apply (rule_tac x = A in exI)
apply (force intro: update_type)
apply (simp (no_asm_simp) add: mset_of_def mcount_def)
apply (drule_tac x = "M (a := M ` a #- 1) " in spec)
apply (drule mp, drule_tac [2] mp, simp_all)
apply (rule_tac x = A in exI)
apply (auto intro: update_type)
apply (subgoal_tac "Finite ({x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}) ")
prefer 2 apply (blast intro: Collect_subset [THEN subset_Finite] Finite_cons)
apply (drule_tac A = "{x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}" in setsum_decr)
apply (drule_tac x = M in spec)
apply (subgoal_tac "multiset (M) ")
 prefer 2
 apply (simp add: multiset_def multiset_fun_iff)
 apply (rule_tac x = A in exI, force)
apply (simp_all add: mset_of_def)
apply (drule_tac psi = "\<forall>x \<in> A. u(x)" for u in asm_rl)
apply (drule_tac x = a in bspec)
apply (simp (no_asm_simp))
apply (subgoal_tac "cons (a, A) = A")
prefer 2 apply blast
apply simp
apply (subgoal_tac "M=cons (<a, M`a>, funrestrict (M, A-{a}))")
 prefer 2
 apply (rule fun_cons_funrestrict_eq)
 apply (subgoal_tac "cons (a, A-{a}) = A")
  apply force
  apply force
apply (rule_tac a = "cons (<a, 1>, funrestrict (M, A - {a}))" in ssubst)
apply simp
apply (frule multiset_funrestict, assumption)
apply (rule prem1, assumption)
apply (simp add: mset_of_def)
apply (drule_tac x = "funrestrict (M, A-{a}) " in spec)
apply (drule mp)
apply (rule_tac x = "A-{a}" in exI)
apply (auto intro: Finite_Diff funrestrict_type simp add: funrestrict)
apply (frule_tac A = A and M = M and a = a in setsum_decr3)
apply (simp (no_asm_simp) add: multiset_def multiset_fun_iff)
apply blast
apply (simp (no_asm_simp) add: mset_of_def)
apply (drule_tac b = "if u then v else w" for u v w in sym, simp_all)
apply (subgoal_tac "{x \<in> A - {a} . 0 < funrestrict (M, A - {x}) ` x} = A - {a}")
apply (auto intro!: setsum_cong simp add: zdiff_eq_iff zadd_commute multiset_def multiset_fun_iff mset_of_def)
done

lemma multiset_induct2:
  "[| multiset(M); P(0);
    (!!M a. [| multiset(M); a\<notin>mset_of(M); P(M) |] ==> P(cons(<a, 1>, M)));
    (!!M b. [| multiset(M); b \<in> mset_of(M);  P(M) |] ==> P(M(b:= M`b #+ 1))) |]
     ==> P(M)"
apply (subgoal_tac "\<exists>n \<in> nat. setsum (\<lambda>x. $# mcount (M, x), {x \<in> mset_of (M) . 0 < M ` x}) = $# n")
apply (rule_tac [2] not_zneg_int_of)
apply (simp_all (no_asm_simp) add: znegative_iff_zless_0 not_zless_iff_zle)
apply (rule_tac [2] g_zpos_imp_setsum_zpos)
prefer 2 apply (blast intro:  multiset_set_of_Finite Collect_subset [THEN subset_Finite])
 prefer 2 apply (simp add: multiset_def multiset_fun_iff, clarify)
apply (rule multiset_induct_aux [rule_format], auto)
done

lemma munion_single_case1:
     "[| multiset(M); a \<notin>mset_of(M) |] ==> M +# {#a#} = cons(<a, 1>, M)"
apply (simp add: multiset_def msingle_def)
apply (auto simp add: munion_def)
apply (unfold mset_of_def, simp)
apply (rule fun_extension, rule lam_type, simp_all)
apply (auto simp add: multiset_fun_iff fun_extend_apply)
apply (drule_tac c = a and b = 1 in fun_extend3)
apply (auto simp add: cons_eq Un_commute [of _ "{a}"])
done

lemma munion_single_case2:
     "[| multiset(M); a \<in> mset_of(M) |] ==> M +# {#a#} = M(a:=M`a #+ 1)"
apply (simp add: multiset_def)
apply (auto simp add: munion_def multiset_fun_iff msingle_def)
apply (unfold mset_of_def, simp)
apply (subgoal_tac "A \<union> {a} = A")
apply (rule fun_extension)
apply (auto dest: domain_type intro: lam_type update_type)
done

(* Induction principle for multisets *)

lemma multiset_induct:
  assumes M: "multiset(M)"
      and P0: "P(0)"
      and step: "!!M a. [| multiset(M); P(M) |] ==> P(M +# {#a#})"
  shows "P(M)"
apply (rule multiset_induct2 [OF M])
apply (simp_all add: P0)
apply (frule_tac [2] a = b in munion_single_case2 [symmetric])
apply (frule_tac a = a in munion_single_case1 [symmetric])
apply (auto intro: step)
done

(** MCollect **)

lemma MCollect_multiset [simp]:
     "multiset(M) ==> multiset({# x \<in> M. P(x)#})"
apply (simp add: MCollect_def multiset_def mset_of_def, clarify)
apply (rule_tac x = "{x \<in> A. P (x) }" in exI)
apply (auto dest: CollectD1 [THEN [2] apply_type]
            intro: Collect_subset [THEN subset_Finite] funrestrict_type)
done

lemma mset_of_MCollect [simp]:
     "multiset(M) ==> mset_of({# x \<in> M. P(x) #}) \<subseteq> mset_of(M)"
by (auto simp add: mset_of_def MCollect_def multiset_def funrestrict_def)

lemma MCollect_mem_iff [iff]:
     "x \<in> mset_of({#x \<in> M. P(x)#}) \<longleftrightarrow>  x \<in> mset_of(M) & P(x)"
by (simp add: MCollect_def mset_of_def)

lemma mcount_MCollect [simp]:
     "mcount({# x \<in> M. P(x) #}, a) = (if P(a) then mcount(M,a) else 0)"
by (simp add: mcount_def MCollect_def mset_of_def)

lemma multiset_partition: "multiset(M) ==> M = {# x \<in> M. P(x) #} +# {# x \<in> M. ~ P(x) #}"
by (simp add: multiset_equality)

lemma natify_elem_is_self [simp]:
     "[| multiset(M); a \<in> mset_of(M) |] ==> natify(M`a) = M`a"
by (auto simp add: multiset_def mset_of_def multiset_fun_iff)

(* and more algebraic laws on multisets *)

lemma munion_eq_conv_diff: "[| multiset(M); multiset(N) |]
  ==>  (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>  (M = N & a = b |
       M = N -# {#a#} +# {#b#} & N = M -# {#b#} +# {#a#})"
apply (simp del: mcount_single add: multiset_equality)
apply (rule iffI, erule_tac [2] disjE, erule_tac [3] conjE)
apply (case_tac "a=b", auto)
apply (drule_tac x = a in spec)
apply (drule_tac [2] x = b in spec)
apply (drule_tac [3] x = aa in spec)
apply (drule_tac [4] x = a in spec, auto)
apply (subgoal_tac [!] "mcount (N,a) :nat")
apply (erule_tac [3] natE, erule natE, auto)
done

lemma melem_diff_single:
"multiset(M) ==>
  k \<in> mset_of(M -# {#a#}) \<longleftrightarrow> (k=a & 1 < mcount(M,a)) | (k\<noteq> a & k \<in> mset_of(M))"
apply (simp add: multiset_def)
apply (simp add: normalize_def mset_of_def msingle_def mdiff_def mcount_def)
apply (auto dest: domain_type intro: zero_less_diff [THEN iffD1]
            simp add: multiset_fun_iff apply_iff)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
done

lemma munion_eq_conv_exist:
"[| M \<in> Mult(A); N \<in> Mult(A) |]
  ==> (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>
      (M=N & a=b | (\<exists>K \<in> Mult(A). M= K +# {#b#} & N=K +# {#a#}))"
by (auto simp add: Mult_iff_multiset melem_diff_single munion_eq_conv_diff)

subsection\<open>Multiset Orderings\<close>

(* multiset on a domain A are finite functions from A to nat-{0} *)

(* multirel1 type *)

lemma multirel1_type: "multirel1(A, r) \<subseteq> Mult(A)*Mult(A)"
by (auto simp add: multirel1_def)

lemma multirel1_0 [simp]: "multirel1(0, r) =0"
by (auto simp add: multirel1_def)

lemma multirel1_iff:
" <N, M> \<in> multirel1(A, r) \<longleftrightarrow>
  (\<exists>a. a \<in> A &
  (\<exists>M0. M0 \<in> Mult(A) & (\<exists>K. K \<in> Mult(A) &
   M=M0 +# {#a#} & N=M0 +# K & (\<forall>b \<in> mset_of(K). <b,a> \<in> r))))"
by (auto simp add: multirel1_def Mult_iff_multiset Bex_def)

text\<open>Monotonicity of \<^term>\<open>multirel1\<close>\<close>

lemma multirel1_mono1: "A\<subseteq>B ==> multirel1(A, r)\<subseteq>multirel1(B, r)"
apply (auto simp add: multirel1_def)
apply (auto simp add: Un_subset_iff Mult_iff_multiset)
apply (rule_tac x = a in bexI)
apply (rule_tac x = M0 in bexI, simp)
apply (rule_tac x = K in bexI)
apply (auto simp add: Mult_iff_multiset)
done

lemma multirel1_mono2: "r\<subseteq>s ==> multirel1(A,r)\<subseteq>multirel1(A, s)"
apply (simp add: multirel1_def, auto)
apply (rule_tac x = a in bexI)
apply (rule_tac x = M0 in bexI)
apply (simp_all add: Mult_iff_multiset)
apply (rule_tac x = K in bexI)
apply (simp_all add: Mult_iff_multiset, auto)
done

lemma multirel1_mono:
     "[| A\<subseteq>B; r\<subseteq>s |] ==> multirel1(A, r) \<subseteq> multirel1(B, s)"
apply (rule subset_trans)
apply (rule multirel1_mono1)
apply (rule_tac [2] multirel1_mono2, auto)
done

subsection\<open>Toward the proof of well-foundedness of multirel1\<close>

lemma not_less_0 [iff]: "<M,0> \<notin> multirel1(A, r)"
by (auto simp add: multirel1_def Mult_iff_multiset)

lemma less_munion: "[| <N, M0 +# {#a#}> \<in> multirel1(A, r); M0 \<in> Mult(A) |] ==>
  (\<exists>M. <M, M0> \<in> multirel1(A, r) & N = M +# {#a#}) |
  (\<exists>K. K \<in> Mult(A) & (\<forall>b \<in> mset_of(K). <b, a> \<in> r) & N = M0 +# K)"
apply (frule multirel1_type [THEN subsetD])
apply (simp add: multirel1_iff)
apply (auto simp add: munion_eq_conv_exist)
apply (rule_tac x="Ka +# K" in exI, auto, simp add: Mult_iff_multiset)
apply (simp (no_asm_simp) add: munion_left_cancel munion_assoc)
apply (auto simp add: munion_commute)
done

lemma multirel1_base: "[| M \<in> Mult(A); a \<in> A |] ==> <M, M +# {#a#}> \<in> multirel1(A, r)"
apply (auto simp add: multirel1_iff)
apply (simp add: Mult_iff_multiset)
apply (rule_tac x = a in exI, clarify)
apply (rule_tac x = M in exI, simp)
apply (rule_tac x = 0 in exI, auto)
done

lemma acc_0: "acc(0)=0"
by (auto intro!: equalityI dest: acc.dom_subset [THEN subsetD])

lemma lemma1: "[| \<forall>b \<in> A. <b,a> \<in> r \<longrightarrow>
    (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#}:acc(multirel1(A, r)));
    M0 \<in> acc(multirel1(A, r)); a \<in> A;
    \<forall>M. <M,M0> \<in> multirel1(A, r) \<longrightarrow> M +# {#a#} \<in> acc(multirel1(A, r)) |]
  ==> M0 +# {#a#} \<in> acc(multirel1(A, r))"
apply (subgoal_tac "M0 \<in> Mult(A) ")
 prefer 2
 apply (erule acc.cases)
 apply (erule fieldE)
 apply (auto dest: multirel1_type [THEN subsetD])
apply (rule accI)
apply (rename_tac "N")
apply (drule less_munion, blast)
apply (auto simp add: Mult_iff_multiset)
apply (erule_tac P = "\<forall>x \<in> mset_of (K) . <x, a> \<in> r" in rev_mp)
apply (erule_tac P = "mset_of (K) \<subseteq>A" in rev_mp)
apply (erule_tac M = K in multiset_induct)
(* three subgoals *)
(* subgoal 1 \<in> the induction base case *)
apply (simp (no_asm_simp))
(* subgoal 2 \<in> the induction general case *)
apply (simp add: Ball_def Un_subset_iff, clarify)
apply (drule_tac x = aa in spec, simp)
apply (subgoal_tac "aa \<in> A")
prefer 2 apply blast
apply (drule_tac x = "M0 +# M" and P =
       "%x. x \<in> acc(multirel1(A, r)) \<longrightarrow> Q(x)" for Q in spec)
apply (simp add: munion_assoc [symmetric])
(* subgoal 3 \<in> additional conditions *)
apply (auto intro!: multirel1_base [THEN fieldI2] simp add: Mult_iff_multiset)
done

lemma lemma2: "[| \<forall>b \<in> A. <b,a> \<in> r
   \<longrightarrow> (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#} :acc(multirel1(A, r)));
        M \<in> acc(multirel1(A, r)); a \<in> A|] ==> M +# {#a#} \<in> acc(multirel1(A, r))"
apply (erule acc_induct)
apply (blast intro: lemma1)
done

lemma lemma3: "[| wf[A](r); a \<in> A |]
      ==> \<forall>M \<in> acc(multirel1(A, r)). M +# {#a#} \<in> acc(multirel1(A, r))"
apply (erule_tac a = a in wf_on_induct, blast)
apply (blast intro: lemma2)
done

lemma lemma4: "multiset(M) ==> mset_of(M)\<subseteq>A \<longrightarrow>
   wf[A](r) \<longrightarrow> M \<in> field(multirel1(A, r)) \<longrightarrow> M \<in> acc(multirel1(A, r))"
apply (erule multiset_induct)
(* proving the base case *)
apply clarify
apply (rule accI, force)
apply (simp add: multirel1_def)
(* Proving the general case *)
apply clarify
apply simp
apply (subgoal_tac "mset_of (M) \<subseteq>A")
prefer 2 apply blast
apply clarify
apply (drule_tac a = a in lemma3, blast)
apply (subgoal_tac "M \<in> field (multirel1 (A,r))")
apply blast
apply (rule multirel1_base [THEN fieldI1])
apply (auto simp add: Mult_iff_multiset)
done

lemma all_accessible: "[| wf[A](r); M \<in> Mult(A); A \<noteq> 0|] ==> M \<in> acc(multirel1(A, r))"
apply (erule not_emptyE)
apply  (rule lemma4 [THEN mp, THEN mp, THEN mp])
apply (rule_tac [4] multirel1_base [THEN fieldI1])
apply  (auto simp add: Mult_iff_multiset)
done

lemma wf_on_multirel1: "wf[A](r) ==> wf[A-||>nat-{0}](multirel1(A, r))"
apply (case_tac "A=0")
apply (simp (no_asm_simp))
apply (rule wf_imp_wf_on)
apply (rule wf_on_field_imp_wf)
apply (simp (no_asm_simp) add: wf_on_0)
apply (rule_tac A = "acc (multirel1 (A,r))" in wf_on_subset_A)
apply (rule wf_on_acc)
apply (blast intro: all_accessible)
done

lemma wf_multirel1: "wf(r) ==>wf(multirel1(field(r), r))"
apply (simp (no_asm_use) add: wf_iff_wf_on_field)
apply (drule wf_on_multirel1)
apply (rule_tac A = "field (r) -||> nat - {0}" in wf_on_subset_A)
apply (simp (no_asm_simp))
apply (rule field_rel_subset)
apply (rule multirel1_type)
done

(** multirel **)

lemma multirel_type: "multirel(A, r) \<subseteq> Mult(A)*Mult(A)"
apply (simp add: multirel_def)
apply (rule trancl_type [THEN subset_trans])
apply (auto dest: multirel1_type [THEN subsetD])
done

(* Monotonicity of multirel *)
lemma multirel_mono:
     "[| A\<subseteq>B; r\<subseteq>s |] ==> multirel(A, r)\<subseteq>multirel(B,s)"
apply (simp add: multirel_def)
apply (rule trancl_mono)
apply (rule multirel1_mono, auto)
done

(* Equivalence of multirel with the usual (closure-free) definition *)

lemma add_diff_eq: "k \<in> nat ==> 0 < k \<longrightarrow> n #+ k #- 1 = n #+ (k #- 1)"
by (erule nat_induct, auto)

lemma mdiff_union_single_conv: "[|a \<in> mset_of(J); multiset(I); multiset(J) |]
   ==> I +# J -# {#a#} = I +# (J-# {#a#})"
apply (simp (no_asm_simp) add: multiset_equality)
apply (case_tac "a \<notin> mset_of (I) ")
apply (auto simp add: mcount_def mset_of_def multiset_def multiset_fun_iff)
apply (auto dest: domain_type simp add: add_diff_eq)
done

lemma diff_add_commute: "[| n \<le> m;  m \<in> nat; n \<in> nat; k \<in> nat |] ==> m #- n #+ k = m #+ k #- n"
by (auto simp add: le_iff less_iff_succ_add)

(* One direction *)

lemma multirel_implies_one_step:
"<M,N> \<in> multirel(A, r) ==>
     trans[A](r) \<longrightarrow>
     (\<exists>I J K.
         I \<in> Mult(A) & J \<in> Mult(A) &  K \<in> Mult(A) &
         N = I +# J & M = I +# K & J \<noteq> 0 &
        (\<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). <k,j> \<in> r))"
apply (simp add: multirel_def Ball_def Bex_def)
apply (erule converse_trancl_induct)
apply (simp_all add: multirel1_iff Mult_iff_multiset)
(* Two subgoals remain *)
(* Subgoal 1 *)
apply clarify
apply (rule_tac x = M0 in exI, force)
(* Subgoal 2 *)
apply clarify
apply hypsubst_thin
apply (case_tac "a \<in> mset_of (Ka) ")
apply (rule_tac x = I in exI, simp (no_asm_simp))
apply (rule_tac x = J in exI, simp (no_asm_simp))
apply (rule_tac x = " (Ka -# {#a#}) +# K" in exI, simp (no_asm_simp))
apply (simp_all add: Un_subset_iff)
apply (simp (no_asm_simp) add: munion_assoc [symmetric])
apply (drule_tac t = "%M. M-#{#a#}" in subst_context)
apply (simp add: mdiff_union_single_conv melem_diff_single, clarify)
apply (erule disjE, simp)
apply (erule disjE, simp)
apply (drule_tac x = a and P = "%x. x :# Ka \<longrightarrow> Q(x)" for Q in spec)
apply clarify
apply (rule_tac x = xa in exI)
apply (simp (no_asm_simp))
apply (blast dest: trans_onD)
(* new we know that  a\<notin>mset_of(Ka) *)
apply (subgoal_tac "a :# I")
apply (rule_tac x = "I-#{#a#}" in exI, simp (no_asm_simp))
apply (rule_tac x = "J+#{#a#}" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule_tac x = "Ka +# K" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule conjI)
apply (simp (no_asm_simp) add: multiset_equality mcount_elem [THEN succ_pred_eq_self])
apply (rule conjI)
apply (drule_tac t = "%M. M-#{#a#}" in subst_context)
apply (simp add: mdiff_union_inverse2)
apply (simp_all (no_asm_simp) add: multiset_equality)
apply (rule diff_add_commute [symmetric])
apply (auto intro: mcount_elem)
apply (subgoal_tac "a \<in> mset_of (I +# Ka) ")
apply (drule_tac [2] sym, auto)
done

lemma melem_imp_eq_diff_union [simp]: "[| a \<in> mset_of(M); multiset(M) |] ==> M -# {#a#} +# {#a#} = M"
by (simp add: multiset_equality mcount_elem [THEN succ_pred_eq_self])

lemma msize_eq_succ_imp_eq_union:
     "[| msize(M)=$# succ(n); M \<in> Mult(A); n \<in> nat |]
      ==> \<exists>a N. M = N +# {#a#} & N \<in> Mult(A) & a \<in> A"
apply (drule msize_eq_succ_imp_elem, auto)
apply (rule_tac x = a in exI)
apply (rule_tac x = "M -# {#a#}" in exI)
apply (frule Mult_into_multiset)
apply (simp (no_asm_simp))
apply (auto simp add: Mult_iff_multiset)
done

(* The second direction *)

lemma one_step_implies_multirel_lemma [rule_format (no_asm)]:
"n \<in> nat ==>
   (\<forall>I J K.
    I \<in> Mult(A) & J \<in> Mult(A) & K \<in> Mult(A) &
   (msize(J) = $# n & J \<noteq>0 &  (\<forall>k \<in> mset_of(K).  \<exists>j \<in> mset_of(J). <k, j> \<in> r))
    \<longrightarrow> <I +# K, I +# J> \<in> multirel(A, r))"
apply (simp add: Mult_iff_multiset)
apply (erule nat_induct, clarify)
apply (drule_tac M = J in msize_eq_0_iff, auto)
(* one subgoal remains *)
apply (subgoal_tac "msize (J) =$# succ (x) ")
 prefer 2 apply simp
apply (frule_tac A = A in msize_eq_succ_imp_eq_union)
apply (simp_all add: Mult_iff_multiset, clarify)
apply (rename_tac "J'", simp)
apply (case_tac "J' = 0")
apply (simp add: multirel_def)
apply (rule r_into_trancl, clarify)
apply (simp add: multirel1_iff Mult_iff_multiset, force)
(*Now we know J' \<noteq>  0*)
apply (drule sym, rotate_tac -1, simp)
apply (erule_tac V = "$# x = msize (J') " in thin_rl)
apply (frule_tac M = K and P = "%x. <x,a> \<in> r" in multiset_partition)
apply (erule_tac P = "\<forall>k \<in> mset_of (K) . P(k)" for P in rev_mp)
apply (erule ssubst)
apply (simp add: Ball_def, auto)
apply (subgoal_tac "< (I +# {# x \<in> K. <x, a> \<in> r#}) +# {# x \<in> K. <x, a> \<notin> r#}, (I +# {# x \<in> K. <x, a> \<in> r#}) +# J'> \<in> multirel(A, r) ")
 prefer 2
 apply (drule_tac x = "I +# {# x \<in> K. <x, a> \<in> r#}" in spec)
 apply (rotate_tac -1)
 apply (drule_tac x = "J'" in spec)
 apply (rotate_tac -1)
 apply (drule_tac x = "{# x \<in> K. <x, a> \<notin> r#}" in spec, simp) apply blast
apply (simp add: munion_assoc [symmetric] multirel_def)
apply (rule_tac b = "I +# {# x \<in> K. <x, a> \<in> r#} +# J'" in trancl_trans, blast)
apply (rule r_into_trancl)
apply (simp add: multirel1_iff Mult_iff_multiset)
apply (rule_tac x = a in exI)
apply (simp (no_asm_simp))
apply (rule_tac x = "I +# J'" in exI)
apply (auto simp add: munion_ac Un_subset_iff)
done

lemma one_step_implies_multirel:
     "[| J \<noteq> 0;  \<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). <k,j> \<in> r;
         I \<in> Mult(A); J \<in> Mult(A); K \<in> Mult(A) |]
      ==> <I+#K, I+#J> \<in> multirel(A, r)"
apply (subgoal_tac "multiset (J) ")
 prefer 2 apply (simp add: Mult_iff_multiset)
apply (frule_tac M = J in msize_int_of_nat)
apply (auto intro: one_step_implies_multirel_lemma)
done

(** Proving that multisets are partially ordered **)

(*irreflexivity*)

lemma multirel_irrefl_lemma:
     "Finite(A) ==> part_ord(A, r) \<longrightarrow> (\<forall>x \<in> A. \<exists>y \<in> A. <x,y> \<in> r) \<longrightarrow>A=0"
apply (erule Finite_induct)
apply (auto dest: subset_consI [THEN [2] part_ord_subset])
apply (auto simp add: part_ord_def irrefl_def)
apply (drule_tac x = xa in bspec)
apply (drule_tac [2] a = xa and b = x in trans_onD, auto)
done

lemma irrefl_on_multirel:
     "part_ord(A, r) ==> irrefl(Mult(A), multirel(A, r))"
apply (simp add: irrefl_def)
apply (subgoal_tac "trans[A](r) ")
 prefer 2 apply (simp add: part_ord_def, clarify)
apply (drule multirel_implies_one_step, clarify)
apply (simp add: Mult_iff_multiset, clarify)
apply (subgoal_tac "Finite (mset_of (K))")
apply (frule_tac r = r in multirel_irrefl_lemma)
apply (frule_tac B = "mset_of (K) " in part_ord_subset)
apply simp_all
apply (auto simp add: multiset_def mset_of_def)
done

lemma trans_on_multirel: "trans[Mult(A)](multirel(A, r))"
apply (simp add: multirel_def trans_on_def)
apply (blast intro: trancl_trans)
done

lemma multirel_trans:
 "[| <M, N> \<in> multirel(A, r); <N, K> \<in> multirel(A, r) |] ==>  <M, K> \<in> multirel(A,r)"
apply (simp add: multirel_def)
apply (blast intro: trancl_trans)
done

lemma trans_multirel: "trans(multirel(A,r))"
apply (simp add: multirel_def)
apply (rule trans_trancl)
done

lemma part_ord_multirel: "part_ord(A,r) ==> part_ord(Mult(A), multirel(A, r))"
apply (simp (no_asm) add: part_ord_def)
apply (blast intro: irrefl_on_multirel trans_on_multirel)
done

(** Monotonicity of multiset union **)

lemma munion_multirel1_mono:
"[|<M,N> \<in> multirel1(A, r); K \<in> Mult(A) |] ==> <K +# M, K +# N> \<in> multirel1(A, r)"
apply (frule multirel1_type [THEN subsetD])
apply (auto simp add: multirel1_iff Mult_iff_multiset)
apply (rule_tac x = a in exI)
apply (simp (no_asm_simp))
apply (rule_tac x = "K+#M0" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule_tac x = Ka in exI)
apply (simp (no_asm_simp) add: munion_assoc)
done

lemma munion_multirel_mono2:
 "[| <M, N> \<in> multirel(A, r); K \<in> Mult(A) |]==><K +# M, K +# N> \<in> multirel(A, r)"
apply (frule multirel_type [THEN subsetD])
apply (simp (no_asm_use) add: multirel_def)
apply clarify
apply (drule_tac psi = "<M,N> \<in> multirel1 (A, r) ^+" in asm_rl)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule trancl_induct, clarify)
apply (blast intro: munion_multirel1_mono r_into_trancl, clarify)
apply (subgoal_tac "y \<in> Mult(A) ")
 prefer 2
 apply (blast dest: multirel_type [unfolded multirel_def, THEN subsetD])
apply (subgoal_tac "<K +# y, K +# z> \<in> multirel1 (A, r) ")
prefer 2 apply (blast intro: munion_multirel1_mono)
apply (blast intro: r_into_trancl trancl_trans)
done

lemma munion_multirel_mono1:
     "[|<M, N> \<in> multirel(A, r); K \<in> Mult(A)|] ==> <M +# K, N +# K> \<in> multirel(A, r)"
apply (frule multirel_type [THEN subsetD])
apply (rule_tac P = "%x. <x,u> \<in> multirel(A, r)" for u in munion_commute [THEN subst])
apply (subst munion_commute [of N])
apply (rule munion_multirel_mono2)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_multirel_mono:
     "[|<M,K> \<in> multirel(A, r); <N,L> \<in> multirel(A, r)|]
      ==> <M +# N, K +# L> \<in> multirel(A, r)"
apply (subgoal_tac "M \<in> Mult(A) & N \<in> Mult(A) & K \<in> Mult(A) & L \<in> Mult(A) ")
prefer 2 apply (blast dest: multirel_type [THEN subsetD])
apply (blast intro: munion_multirel_mono1 multirel_trans munion_multirel_mono2)
done

subsection\<open>Ordinal Multisets\<close>

(* A \<subseteq> B ==>  field(Memrel(A)) \<subseteq> field(Memrel(B)) *)
lemmas field_Memrel_mono = Memrel_mono [THEN field_mono]

(*
[| Aa \<subseteq> Ba; A \<subseteq> B |] ==>
multirel(field(Memrel(Aa)), Memrel(A))\<subseteq> multirel(field(Memrel(Ba)), Memrel(B))
*)

lemmas multirel_Memrel_mono = multirel_mono [OF field_Memrel_mono Memrel_mono]

lemma omultiset_is_multiset [simp]: "omultiset(M) ==> multiset(M)"
apply (simp add: omultiset_def)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_omultiset [simp]: "[| omultiset(M); omultiset(N) |] ==> omultiset(M +# N)"
apply (simp add: omultiset_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
apply (blast intro: field_Memrel_mono)
done

lemma mdiff_omultiset [simp]: "omultiset(M) ==> omultiset(M -# N)"
apply (simp add: omultiset_def, clarify)
apply (simp add: Mult_iff_multiset)
apply (rule_tac x = i in exI)
apply (simp (no_asm_simp))
done

(** Proving that Memrel is a partial order **)

lemma irrefl_Memrel: "Ord(i) ==> irrefl(field(Memrel(i)), Memrel(i))"
apply (rule irreflI, clarify)
apply (subgoal_tac "Ord (x) ")
prefer 2 apply (blast intro: Ord_in_Ord)
apply (drule_tac i = x in ltI [THEN lt_irrefl], auto)
done

lemma trans_iff_trans_on: "trans(r) \<longleftrightarrow> trans[field(r)](r)"
by (simp add: trans_on_def trans_def, auto)

lemma part_ord_Memrel: "Ord(i) ==>part_ord(field(Memrel(i)), Memrel(i))"
apply (simp add: part_ord_def)
apply (simp (no_asm) add: trans_iff_trans_on [THEN iff_sym])
apply (blast intro: trans_Memrel irrefl_Memrel)
done

(*
  Ord(i) ==>
  part_ord(field(Memrel(i))-||>nat-{0}, multirel(field(Memrel(i)), Memrel(i)))
*)

lemmas part_ord_mless = part_ord_Memrel [THEN part_ord_multirel]

(*irreflexivity*)

lemma mless_not_refl: "~(M <# M)"
apply (simp add: mless_def, clarify)
apply (frule multirel_type [THEN subsetD])
apply (drule part_ord_mless)
apply (simp add: part_ord_def irrefl_def)
done

(* N<N ==> R *)
lemmas mless_irrefl = mless_not_refl [THEN notE, elim!]

(*transitivity*)
lemma mless_trans: "[| K <# M; M <# N |] ==> K <# N"
apply (simp add: mless_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (blast dest: multirel_Memrel_mono [OF Un_upper1 Un_upper1, THEN subsetD]
                   multirel_Memrel_mono [OF Un_upper2 Un_upper2, THEN subsetD]
        intro: multirel_trans Ord_Un)
done

(*asymmetry*)
lemma mless_not_sym: "M <# N ==> ~ N <# M"
apply clarify
apply (rule mless_not_refl [THEN notE])
apply (erule mless_trans, assumption)
done

lemma mless_asym: "[| M <# N; ~P ==> N <# M |] ==> P"
by (blast dest: mless_not_sym)

lemma mle_refl [simp]: "omultiset(M) ==> M <#= M"
by (simp add: mle_def)

(*anti-symmetry*)
lemma mle_antisym:
     "[| M <#= N;  N <#= M |] ==> M = N"
apply (simp add: mle_def)
apply (blast dest: mless_not_sym)
done

(*transitivity*)
lemma mle_trans: "[| K <#= M; M <#= N |] ==> K <#= N"
apply (simp add: mle_def)
apply (blast intro: mless_trans)
done

lemma mless_le_iff: "M <# N \<longleftrightarrow> (M <#= N & M \<noteq> N)"
by (simp add: mle_def, auto)

(** Monotonicity of mless **)

lemma munion_less_mono2: "[| M <# N; omultiset(K) |] ==> K +# M <# K +# N"
apply (simp add: mless_def omultiset_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
apply (rule munion_multirel_mono2)
 apply (blast intro: multirel_Memrel_mono [THEN subsetD])
apply (simp add: Mult_iff_multiset)
apply (blast intro: field_Memrel_mono [THEN subsetD])
done

lemma munion_less_mono1: "[| M <# N; omultiset(K) |] ==> M +# K <# N +# K"
by (force dest: munion_less_mono2 simp add: munion_commute)

lemma mless_imp_omultiset: "M <# N ==> omultiset(M) & omultiset(N)"
by (auto simp add: mless_def omultiset_def dest: multirel_type [THEN subsetD])

lemma munion_less_mono: "[| M <# K; N <# L |] ==> M +# N <# K +# L"
apply (frule_tac M = M in mless_imp_omultiset)
apply (frule_tac M = N in mless_imp_omultiset)
apply (blast intro: munion_less_mono1 munion_less_mono2 mless_trans)
done

(* <#= *)

lemma mle_imp_omultiset: "M <#= N ==> omultiset(M) & omultiset(N)"
by (auto simp add: mle_def mless_imp_omultiset)

lemma mle_mono: "[| M <#= K;  N <#= L |] ==> M +# N <#= K +# L"
apply (frule_tac M = M in mle_imp_omultiset)
apply (frule_tac M = N in mle_imp_omultiset)
apply (auto simp add: mle_def intro: munion_less_mono1 munion_less_mono2 munion_less_mono)
done

lemma omultiset_0 [iff]: "omultiset(0)"
by (auto simp add: omultiset_def Mult_iff_multiset)

lemma empty_leI [simp]: "omultiset(M) ==> 0 <#= M"
apply (simp add: mle_def mless_def)
apply (subgoal_tac "\<exists>i. Ord (i) & M \<in> Mult(field(Memrel(i))) ")
 prefer 2 apply (simp add: omultiset_def)
apply (case_tac "M=0", simp_all, clarify)
apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel(field (Memrel(i)), Memrel(i))")
apply (rule_tac [2] one_step_implies_multirel)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_upper1: "[| omultiset(M); omultiset(N) |] ==> M <#= M +# N"
apply (subgoal_tac "M +# 0 <#= M +# N")
apply (rule_tac [2] mle_mono, auto)
done

end