(*  Title:      HOL/Quotient_Examples/Quotient_Int.thy
    Author:     Cezary Kaliszyk
    Author:     Christian Urban

Integers based on Quotients, based on an older version by Larry
Paulson.
*)

theory Quotient_Int
imports "~~/src/HOL/Library/Quotient_Product" Nat
begin

fun
  intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool" (infix "\<approx>" 50)
where
  "intrel (x, y) (u, v) = (x + v = u + y)"

quotient_type int = "nat \<times> nat" / intrel
  by (auto simp add: equivp_def fun_eq_iff)

instantiation int :: "{zero, one, plus, uminus, minus, times, ord, abs, sgn}"
begin

quotient_definition
  "0 :: int" is "(0::nat, 0::nat)" done

quotient_definition
  "1 :: int" is "(1::nat, 0::nat)" done

fun
  plus_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
where
  "plus_int_raw (x, y) (u, v) = (x + u, y + v)"

quotient_definition
  "(op +) :: (int \<Rightarrow> int \<Rightarrow> int)" is "plus_int_raw" by auto

fun
  uminus_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
where
  "uminus_int_raw (x, y) = (y, x)"

quotient_definition
  "(uminus :: (int \<Rightarrow> int))" is "uminus_int_raw" by auto

definition
  minus_int_def:  "z - w = z + (-w::int)"

fun
  times_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
where
  "times_int_raw (x, y) (u, v) = (x*u + y*v, x*v + y*u)"

lemma times_int_raw_fst:
  assumes a: "x \<approx> z"
  shows "times_int_raw x y \<approx> times_int_raw z y"
  using a
  apply(cases x, cases y, cases z)
  apply(auto simp add: times_int_raw.simps intrel.simps)
  apply(hypsubst_thin)
  apply(rename_tac u v w x y z)
  apply(subgoal_tac "u*w + z*w = y*w + v*w  &  u*x + z*x = y*x + v*x")
  apply(simp add: ac_simps)
  apply(simp add: add_mult_distrib [symmetric])
done

lemma times_int_raw_snd:
  assumes a: "x \<approx> z"
  shows "times_int_raw y x \<approx> times_int_raw y z"
  using a
  apply(cases x, cases y, cases z)
  apply(auto simp add: times_int_raw.simps intrel.simps)
  apply(hypsubst_thin)
  apply(rename_tac u v w x y z)
  apply(subgoal_tac "u*w + z*w = y*w + v*w  &  u*x + z*x = y*x + v*x")
  apply(simp add: ac_simps)
  apply(simp add: add_mult_distrib [symmetric])
done

quotient_definition
  "(op *) :: (int \<Rightarrow> int \<Rightarrow> int)" is "times_int_raw"
  apply(rule equivp_transp[OF int_equivp])
  apply(rule times_int_raw_fst)
  apply(assumption)
  apply(rule times_int_raw_snd)
  apply(assumption)
done

fun
  le_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool"
where
  "le_int_raw (x, y) (u, v) = (x+v \<le> u+y)"

quotient_definition
  le_int_def: "(op \<le>) :: int \<Rightarrow> int \<Rightarrow> bool" is "le_int_raw" by auto

definition
  less_int_def: "(z::int) < w = (z \<le> w \<and> z \<noteq> w)"

definition
  zabs_def: "\<bar>i::int\<bar> = (if i < 0 then - i else i)"

definition
  zsgn_def: "sgn (i::int) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"

instance ..

end

text\<open>The integers form a \<open>comm_ring_1\<close>\<close>

instance int :: comm_ring_1
proof
  fix i j k :: int
  show "(i + j) + k = i + (j + k)"
    by (descending) (auto)
  show "i + j = j + i"
    by (descending) (auto)
  show "0 + i = (i::int)"
    by (descending) (auto)
  show "- i + i = 0"
    by (descending) (auto)
  show "i - j = i + - j"
    by (simp add: minus_int_def)
  show "(i * j) * k = i * (j * k)"
    by (descending) (auto simp add: algebra_simps)
  show "i * j = j * i"
    by (descending) (auto)
  show "1 * i = i"
    by (descending) (auto)
  show "(i + j) * k = i * k + j * k"
    by (descending) (auto simp add: algebra_simps)
  show "0 \<noteq> (1::int)"
    by (descending) (auto)
qed

lemma plus_int_raw_rsp_aux:
  assumes a: "a \<approx> b" "c \<approx> d"
  shows "plus_int_raw a c \<approx> plus_int_raw b d"
  using a
  by (cases a, cases b, cases c, cases d)
     (simp)

lemma add_abs_int:
  "(abs_int (x,y)) + (abs_int (u,v)) =
   (abs_int (x + u, y + v))"
  apply(simp add: plus_int_def id_simps)
  apply(fold plus_int_raw.simps)
  apply(rule Quotient3_rel_abs[OF Quotient3_int])
  apply(rule plus_int_raw_rsp_aux)
  apply(simp_all add: rep_abs_rsp_left[OF Quotient3_int])
  done

definition int_of_nat_raw:
  "int_of_nat_raw m = (m :: nat, 0 :: nat)"

quotient_definition
  "int_of_nat :: nat \<Rightarrow> int" is "int_of_nat_raw" done

lemma int_of_nat:
  shows "of_nat m = int_of_nat m"
  by (induct m)
     (simp_all add: zero_int_def one_int_def int_of_nat_def int_of_nat_raw add_abs_int)

instance int :: linorder
proof
  fix i j k :: int
  show antisym: "i \<le> j \<Longrightarrow> j \<le> i \<Longrightarrow> i = j"
    by (descending) (auto)
  show "(i < j) = (i \<le> j \<and> \<not> j \<le> i)"
    by (auto simp add: less_int_def dest: antisym)
  show "i \<le> i"
    by (descending) (auto)
  show "i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> i \<le> k"
    by (descending) (auto)
  show "i \<le> j \<or> j \<le> i"
    by (descending) (auto)
qed

instantiation int :: distrib_lattice
begin

definition
  "(inf :: int \<Rightarrow> int \<Rightarrow> int) = min"

definition
  "(sup :: int \<Rightarrow> int \<Rightarrow> int) = max"

instance
  by standard (auto simp add: inf_int_def sup_int_def max_min_distrib2)

end

instance int :: ordered_cancel_ab_semigroup_add
proof
  fix i j k :: int
  show "i \<le> j \<Longrightarrow> k + i \<le> k + j"
    by (descending) (auto)
qed

abbreviation
  "less_int_raw i j \<equiv> le_int_raw i j \<and> \<not>(i \<approx> j)"

lemma zmult_zless_mono2_lemma:
  fixes i j::int
  and   k::nat
  shows "i < j \<Longrightarrow> 0 < k \<Longrightarrow> of_nat k * i < of_nat k * j"
  apply(induct "k")
  apply(simp)
  apply(case_tac "k = 0")
  apply(simp_all add: distrib_right add_strict_mono)
  done

lemma zero_le_imp_eq_int_raw:
  fixes k::"(nat \<times> nat)"
  shows "less_int_raw (0, 0) k \<Longrightarrow> (\<exists>n > 0. k \<approx> int_of_nat_raw n)"
  apply(cases k)
  apply(simp add:int_of_nat_raw)
  apply(auto)
  apply(rule_tac i="b" and j="a" in less_Suc_induct)
  apply(auto)
  done

lemma zero_le_imp_eq_int:
  fixes k::int
  shows "0 < k \<Longrightarrow> \<exists>n > 0. k = of_nat n"
  unfolding less_int_def int_of_nat
  by (descending) (rule zero_le_imp_eq_int_raw)

lemma zmult_zless_mono2:
  fixes i j k::int
  assumes a: "i < j" "0 < k"
  shows "k * i < k * j"
  using a
  by (drule_tac zero_le_imp_eq_int) (auto simp add: zmult_zless_mono2_lemma)

text\<open>The integers form an ordered integral domain\<close>

instance int :: linordered_idom
proof
  fix i j k :: int
  show "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
    by (rule zmult_zless_mono2)
  show "\<bar>i\<bar> = (if i < 0 then -i else i)"
    by (simp only: zabs_def)
  show "sgn (i::int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
    by (simp only: zsgn_def)
qed

lemmas int_distrib =
  distrib_right [of z1 z2 w]
  distrib_left [of w z1 z2]
  left_diff_distrib [of z1 z2 w]
  right_diff_distrib [of w z1 z2]
  minus_add_distrib[of z1 z2]
  for z1 z2 w :: int

lemma int_induct2:
  assumes "P 0 0"
  and     "\<And>n m. P n m \<Longrightarrow> P (Suc n) m"
  and     "\<And>n m. P n m \<Longrightarrow> P n (Suc m)"
  shows   "P n m"
using assms
by (induction_schema) (pat_completeness, lexicographic_order)

lemma int_induct:
  fixes j :: int
  assumes a: "P 0"
  and     b: "\<And>i::int. P i \<Longrightarrow> P (i + 1)"
  and     c: "\<And>i::int. P i \<Longrightarrow> P (i - 1)"
  shows      "P j"
using a b c
unfolding minus_int_def
by (descending) (auto intro: int_induct2)

text \<open>Magnitide of an Integer, as a Natural Number: @{term nat}\<close>

definition
  "int_to_nat_raw \<equiv> \<lambda>(x, y).x - (y::nat)"

quotient_definition
  "int_to_nat::int \<Rightarrow> nat"
is
  "int_to_nat_raw"
unfolding int_to_nat_raw_def by auto

lemma nat_le_eq_zle:
  fixes w z::"int"
  shows "0 < w \<or> 0 \<le> z \<Longrightarrow> (int_to_nat w \<le> int_to_nat z) = (w \<le> z)"
  unfolding less_int_def
  by (descending) (auto simp add: int_to_nat_raw_def)

end


theory Dining_Cryptographers
imports "~~/src/HOL/Probability/Information"
begin

lemma image_ex1_eq: "inj_on f A \<Longrightarrow> (b \<in> f ` A) \<longleftrightarrow> (\<exists>!x \<in> A. b = f x)"
  by (unfold inj_on_def) blast

lemma Ex1_eq: "\<exists>!x. P x \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y"
  by auto

subsection {* Define the state space *}

text {*

We introduce the state space on which the algorithm operates.

This contains:

\begin{description}
\item[n]
  The number of cryptographers on the table.

\item[payer]
  Either one of the cryptographers or the NSA.

\item[coin]
  The result of the coin flipping for each cryptographer.

\item[inversion]
  The public result for each cryptographer, e.g. the sum of the coin flipping
  for the cryptographer, its right neighbour and the information if he paid or
  not.

\end{description}

The observables are the \emph{inversions}

*}

locale dining_cryptographers_space =
  fixes n :: nat
  assumes n_gt_3: "n \<ge> 3"
begin

definition "dining_cryptographers =
  ({None} \<union> Some ` {0..<n}) \<times> {xs :: bool list. length xs = n}"
definition "payer dc = fst dc"
definition coin :: "(nat option \<times> bool list) \<Rightarrow> nat \<Rightarrow> bool" where
  "coin dc c = snd dc ! (c mod n)"
definition "inversion dc =
  map (\<lambda>c. (payer dc = Some c) \<noteq> (coin dc c \<noteq> coin dc (c + 1))) [0..<n]"

definition "result dc = foldl (\<lambda> a b. a \<noteq> b) False (inversion dc)"

lemma coin_n[simp]: "coin dc n = coin dc 0"
  unfolding coin_def by simp

theorem correctness:
  assumes "dc \<in> dining_cryptographers"
  shows "result dc \<longleftrightarrow> (payer dc \<noteq> None)"
proof -
  let ?XOR = "\<lambda>f l. foldl (op \<noteq>) False (map f [0..<l])"

  have foldl_coin:
    "\<not> ?XOR (\<lambda>c. coin dc c \<noteq> coin dc (c + 1)) n"
  proof -
    def n' \<equiv> n -- "Need to hide n, as it is hidden in coin"
    have "?XOR (\<lambda>c. coin dc c \<noteq> coin dc (c + 1)) n'
        = (coin dc 0 \<noteq> coin dc n')"
      by (induct n') auto
    thus ?thesis using `n' \<equiv> n` by simp
  qed

  from assms have "payer dc = None \<or> (\<exists>k<n. payer dc = Some k)"
    unfolding dining_cryptographers_def payer_def by auto
  thus ?thesis
  proof (rule disjE)
    assume "payer dc = None"
    thus ?thesis unfolding result_def inversion_def
      using foldl_coin by simp
  next
    assume "\<exists>k<n. payer dc = Some k"
    then obtain k where "k < n" and "payer dc = Some k" by auto
    def l \<equiv> n -- "Need to hide n, as it is hidden in coin, payer etc."
    have "?XOR (\<lambda>c. (payer dc = Some c) \<noteq> (coin dc c \<noteq> coin dc (c + 1))) l =
        ((k < l) \<noteq> ?XOR (\<lambda>c. (coin dc c \<noteq> coin dc (c + 1))) l)"
      using `payer dc = Some k` by (induct l) auto
    thus ?thesis
      unfolding result_def inversion_def l_def
      using `payer dc = Some k` foldl_coin `k < n` by simp
  qed
qed

text {*

We now restrict the state space for the dining cryptographers to the cases when
one of the cryptographer pays.

*}

definition
  "dc_crypto = dining_cryptographers - {None}\<times>UNIV"

lemma dc_crypto: "dc_crypto = Some ` {0..<n} \<times> {xs :: bool list. length xs = n}"
  unfolding dc_crypto_def dining_cryptographers_def by auto

lemma image_payer_dc_crypto: "payer ` dc_crypto = Some ` {0..<n}"
proof -
  have *: "{xs. length xs = n} \<noteq> {}"
    by (auto intro!: exI[of _ "replicate n undefined"])
  show ?thesis
    unfolding payer_def [abs_def] dc_crypto fst_image_times if_not_P[OF *] ..
qed

lemma card_payer_and_inversion:
  assumes "xs \<in> inversion ` dc_crypto" and "i < n"
  shows "card {dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs} = 2"
    (is "card ?S = 2")
proof -
  obtain ys j where xs_inv: "inversion (Some j, ys) = xs" and
    "j < n" and "(Some j, ys) \<in> dc_crypto"
    using assms(1) by (auto simp: dc_crypto)

  hence "length ys = n" by (simp add: dc_crypto)
  have [simp]: "length xs = n" using xs_inv[symmetric] by (simp add: inversion_def)

  { fix b
    have "inj_on (\<lambda>x. inversion (Some i, x)) {ys. ys ! 0 = b \<and> length ys = length xs}"
    proof (rule inj_onI)
      fix x y
      assume "x \<in> {ys. ys ! 0 = b \<and> length ys = length xs}"
        and "y \<in> {ys. ys ! 0 = b \<and> length ys = length xs}"
        and inv: "inversion (Some i, x) = inversion (Some i, y)"
      hence [simp]: "x ! 0 = y ! 0" "length y = n" "length x = n"
        using `length xs = n` by simp_all
      have *: "\<And>j. j < n \<Longrightarrow>
        (x ! j = x ! (Suc j mod n)) = (y ! j = y ! (Suc j mod n))"
        using inv unfolding inversion_def map_eq_conv payer_def coin_def
        by fastforce
      show "x = y"
      proof (rule nth_equalityI, simp, rule allI, rule impI)
        fix j assume "j < length x" hence "j < n" using `length xs = n` by simp
        thus "x ! j = y ! j"
        proof (induct j)
          case (Suc j)
          hence "j < n" by simp
          with Suc show ?case using *[OF `j < n`]
            by (cases "y ! j") simp_all
        qed simp
      qed
    qed }
  note inj_inv = this

  txt {*
    We now construct the possible inversions for @{term xs} when the payer is
    @{term i}.
  *}

  def zs \<equiv> "map (\<lambda>p. if p \<in> {min i j<..max i j} then \<not> ys ! p else ys ! p) [0..<n]"
  hence [simp]: "length zs = n" by simp
  hence [simp]: "0 < length zs" using n_gt_3 by simp

  have "\<And>l. l < max i j \<Longrightarrow> Suc l mod n = Suc l"
    using `i < n` `j < n` by auto
  { fix l assume "l < n"
    hence "(((l < min i j \<or> l = min i j) \<or> (min i j < l \<and> l < max i j)) \<or> l = max i j) \<or> max i j < l" by auto
    hence "((i = l) = (zs ! l = zs ! (Suc l mod n))) = ((j = l) = (ys ! l = ys ! (Suc l mod n)))"
    apply - proof ((erule disjE)+)
      assume "l < min i j"
      hence "l \<noteq> i" and "l \<noteq> j" and "zs ! l = ys ! l" and
        "zs ! (Suc l mod n) = ys ! (Suc l mod n)" using `i < n` `j < n` unfolding zs_def by auto
      thus ?thesis by simp
    next
      assume "l = min i j"
      show ?thesis
      proof (cases rule: linorder_cases)
        assume "i < j"
        hence "l = i" and "Suc l < n" and "i \<noteq> j" and "Suc l \<le> max i j" using `l = min i j` using `j < n` by auto
        hence "zs ! l = ys ! l" and "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
          using `l = min i j`[symmetric] by (simp_all add: zs_def)
        thus ?thesis using `l = i` `i \<noteq> j` by simp
      next
        assume "j < i"
        hence "l = j" and "Suc l < n" and "i \<noteq> j" and "Suc l \<le> max i j" using `l = min i j` using `i < n` by auto
        hence "zs ! l = ys ! l" and "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
          using `l = min i j`[symmetric] by (simp_all add: zs_def)
        thus ?thesis using `l = j` `i \<noteq> j` by simp
      next
        assume "i = j"
        hence "i = j" and "max i j = l" and "min i j = l" and "zs = ys"
          using `l = min i j` by (simp_all add: zs_def `length ys = n`[symmetric] map_nth)
        thus ?thesis by simp
      qed
    next
      assume "min i j < l \<and> l < max i j"
      hence "i \<noteq> l" and "j \<noteq> l" and "zs ! l = (\<not> ys ! l)"
        "zs ! (Suc l mod n) = (\<not> ys ! (Suc l mod n))"
        using `i < n` `j < n` by (auto simp: zs_def)
      thus ?thesis by simp
    next
      assume "l = max i j"
      show ?thesis
      proof (cases rule: linorder_cases)
        assume "i < j"
        hence "l = j" and "i \<noteq> j" using `l = max i j` using `j < n` by auto
        have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
          using `j < n` `i < j` `l = j` by (cases "Suc l = n") (auto simp add: zs_def)
        moreover have "zs ! l = (\<not> ys ! l)"
          using `j < n` `i < j` by (auto simp add: `l = j` zs_def)
        ultimately show ?thesis using `l = j` `i \<noteq> j` by simp
      next
        assume "j < i"
        hence "l = i" and "i \<noteq> j" using `l = max i j` by auto
        have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
          using `i < n` `j < i` `l = i` by (cases "Suc l = n") (auto simp add: zs_def)
        moreover have "zs ! l = (\<not> ys ! l)"
          using `i < n` `j < i` by (auto simp add: `l = i` zs_def)
        ultimately show ?thesis using `l = i` `i \<noteq> j` by auto
      next
        assume "i = j"
        hence "i = j" and "max i j = l" and "min i j = l" and "zs = ys"
          using `l = max i j` by (simp_all add: zs_def `length ys = n`[symmetric] map_nth)
        thus ?thesis by simp
      qed
    next
      assume "max i j < l"
      hence "j \<noteq> l" and "i \<noteq> l" by simp_all
      have "zs ! (Suc l mod n) = ys ! (Suc l mod n)"
        using `l < n` `max i j < l` by (cases "Suc l = n") (auto simp add: zs_def)
      moreover have "zs ! l = ys ! l"
        using `l < n` `max i j < l` by (auto simp add: zs_def)
      ultimately show ?thesis using `j \<noteq> l` `i \<noteq> l` by auto
    qed }
  hence zs: "inversion (Some i, zs) = xs"
    by (simp add: xs_inv[symmetric] inversion_def coin_def payer_def)
  moreover
  from zs have Not_zs: "inversion (Some i, (map Not zs)) = xs"
    by (simp add: xs_inv[symmetric] inversion_def coin_def payer_def)
  ultimately
  have "{dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs} =
    {(Some i, zs), (Some i, map Not zs)}"
    using `i < n` [[ hypsubst_thin = true ]]
  proof (safe, simp_all add:dc_crypto payer_def)
    fix b assume [simp]: "length b = n"
      and *: "inversion (Some i, b) = xs" and "b \<noteq> zs"
    show "b = map Not zs"
    proof (cases "b ! 0 = zs ! 0")
      case True
      hence zs: "zs \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, zs)"
        using zs by simp
      have b: "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, b)"
        using * by simp
      hence "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}" ..
      with *[symmetric] have "xs \<in> (\<lambda>x. inversion (Some i, x)) ` {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}"
         by (rule image_eqI)
      from this[unfolded image_ex1_eq[OF inj_inv]] b zs
      have "b = zs" by (rule Ex1_eq)
      thus ?thesis using `b \<noteq> zs` by simp
    next
      case False
      hence zs: "map Not zs \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, map Not zs)"
        using Not_zs by (simp add: nth_map[OF `0 < length zs`])
      have b: "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs} \<and> xs = inversion (Some i, b)"
        using * by simp
      hence "b \<in> {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}" ..
      with *[symmetric] have "xs \<in> (\<lambda>x. inversion (Some i, x)) ` {ys. ys ! 0 = b ! 0 \<and> length ys = length xs}"
         by (rule image_eqI)
      from this[unfolded image_ex1_eq[OF inj_inv]] b zs
      show "b = map Not zs" by (rule Ex1_eq)
    qed
  qed
  moreover
  have "zs \<noteq> map Not zs"
    using `0 < length zs` by (cases zs) simp_all
  ultimately show ?thesis by simp
qed

lemma finite_dc_crypto: "finite dc_crypto"
  using finite_lists_length_eq[where A="UNIV :: bool set"]
  unfolding dc_crypto by simp

lemma card_inversion:
  assumes "xs \<in> inversion ` dc_crypto"
  shows "card {dc \<in> dc_crypto. inversion dc = xs} = 2 * n"
proof -
  let ?set = "\<lambda>i. {dc \<in> dc_crypto. payer dc = Some i \<and> inversion dc = xs}"
  let ?sets = "{?set i | i. i < n}"

  have [simp]: "length xs = n" using assms
    by (auto simp: dc_crypto inversion_def [abs_def])

  have "{dc \<in> dc_crypto. inversion dc = xs} = (\<Union> i < n. ?set i)"
    unfolding dc_crypto payer_def by auto
  also have "\<dots> = (\<Union> ?sets)" by auto
  finally have eq_Union: "{dc \<in> dc_crypto. inversion dc = xs} = (\<Union> ?sets)" by simp

  have card_double: "2 * card ?sets = card (\<Union> ?sets)"
  proof (rule card_partition)
    show "finite ?sets" by simp
    { fix i assume "i < n"
      have "?set i \<subseteq> dc_crypto" by auto
      have "finite (?set i)" using finite_dc_crypto by auto }
    thus "finite (\<Union>?sets)" by auto

  next
    fix c assume "c \<in> ?sets"
    thus "card c = 2" using card_payer_and_inversion[OF assms] by auto

  next
    fix x y assume "x \<in> ?sets" and "y \<in> ?sets" "x \<noteq> y"
    then obtain i j where xy: "x = ?set i" "y = ?set j" by auto
    hence "i \<noteq> j" using `x \<noteq> y` by auto
    thus "x \<inter> y = {}" using xy by auto
  qed

  have sets: "?sets = ?set ` {..< n}"
    unfolding image_def by auto
  { fix i j :: nat assume asm: "i \<noteq> j" "i < n" "j < n"
    { assume iasm: "?set i = {}"
      have "card (?set i) = 2"
        using card_payer_and_inversion[OF assms `i < n`] by auto
      hence "False"
        using iasm by auto }
    then obtain c where ci: "c \<in> ?set i" by blast
    hence cj: "c \<notin> ?set j" using asm by auto
    { assume "?set i = ?set j"
      hence "False" using ci cj by auto }
    hence "?set i \<noteq> ?set j" by auto }
  hence "inj_on ?set {..< n}" unfolding inj_on_def by auto
  from card_image[OF this]
  have "card (?set ` {..< n}) = n" by auto
  hence "card ?sets = n" using sets by auto
  thus ?thesis using eq_Union card_double by auto
qed

lemma card_dc_crypto:
  "card dc_crypto = n * 2^n"
  unfolding dc_crypto
  using card_lists_length_eq[of "UNIV :: bool set"]
  by (simp add: card_cartesian_product card_image)

lemma card_image_inversion:
  "card (inversion ` dc_crypto) = 2^(n - 1)"
proof -
  let ?P = "{inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}"
  have "\<Union>?P = dc_crypto" by auto

  { fix a b assume *: "(a, b) \<in> dc_crypto"
    have inv_SOME: "inversion (SOME x. inversion x = inversion (a, b) \<and> x \<in> dc_crypto) = inversion (a, b)"
      apply (rule someI2)
      by (auto simp: *) }
  note inv_SOME = this

  { fix a b assume *: "(a, b) \<in> dc_crypto"
    have "(SOME x. inversion x = inversion (a, b) \<and> x \<in> dc_crypto) \<in> dc_crypto"
      by (rule someI2) (auto simp: *) }
  note SOME_inv_dc = this

  have "bij_betw (\<lambda>s. inversion (SOME x. x \<in> s \<and> x \<in> dc_crypto))
    {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}
    (inversion ` dc_crypto)"
    unfolding bij_betw_def
    by (auto intro!: inj_onI image_eqI simp: inv_SOME SOME_inv_dc)
  hence card_eq: "card {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto} = card (inversion ` dc_crypto)"
    by (rule bij_betw_same_card)

  have "(2*n) * card (inversion ` dc_crypto) = card (\<Union>?P)"
    unfolding card_eq[symmetric]
  proof (rule card_partition)
    have "\<Union>?P \<subseteq> dc_crypto" by auto
    thus "finite (\<Union>?P)" using finite_dc_crypto by (auto intro: finite_subset)

    have "?P = (\<lambda>x. inversion -` {x} \<inter> dc_crypto) ` (inversion ` dc_crypto)"
      by auto
    thus "finite ?P" using finite_dc_crypto by auto

  next
    fix c assume "c \<in> {inversion -` {x} \<inter> dc_crypto |x. x \<in> inversion ` dc_crypto}"
    then obtain x where "c = inversion -` {x} \<inter> dc_crypto" and x: "x \<in> inversion ` dc_crypto" by auto
    hence "c = {dc \<in> dc_crypto. inversion dc = x}" by auto
    thus "card c = 2 * n" using card_inversion[OF x] by simp

  next
    fix x y assume "x \<in> ?P" "y \<in> ?P" and "x \<noteq> y"
    then obtain i j where
      x: "x = inversion -` {i} \<inter> dc_crypto" and i: "i \<in> inversion ` dc_crypto" and
      y: "y = inversion -` {j} \<inter> dc_crypto" and j: "j \<in> inversion ` dc_crypto" by auto
    show "x \<inter> y = {}" using x y `x \<noteq> y` by auto
  qed
  hence "2 * card (inversion ` dc_crypto) = 2 ^ n" unfolding `\<Union>?P = dc_crypto` card_dc_crypto
    using n_gt_3 by auto
  thus ?thesis by (cases n) auto
qed

end

sublocale dining_cryptographers_space \<subseteq> prob_space "uniform_count_measure dc_crypto"
  by (rule prob_space_uniform_count_measure[OF finite_dc_crypto])
     (insert n_gt_3, auto simp: dc_crypto intro: exI[of _ "replicate n True"])

sublocale dining_cryptographers_space \<subseteq> information_space "uniform_count_measure dc_crypto" 2
  by default auto

notation (in dining_cryptographers_space)
  mutual_information_Pow ("\<I>'( _ ; _ ')")

notation (in dining_cryptographers_space)
  entropy_Pow ("\<H>'( _ ')")

notation (in dining_cryptographers_space)
  conditional_entropy_Pow ("\<H>'( _ | _ ')")

theorem (in dining_cryptographers_space)
  "\<I>( inversion ; payer ) = 0"
proof (rule mutual_information_eq_0_simple)
  have n: "0 < n" using n_gt_3 by auto
  have card_image_inversion:
    "real (card (inversion ` dc_crypto)) = 2^n / 2"
    unfolding card_image_inversion using `0 < n` by (cases n) auto

  show inversion: "simple_distributed (uniform_count_measure dc_crypto) inversion (\<lambda>x. 2 / 2^n)"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) inversion"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix x assume "x \<in> inversion ` space (uniform_count_measure dc_crypto)"
    moreover have "inversion -` {x} \<inter> dc_crypto = {dc \<in> dc_crypto. inversion dc = x}" by auto
    ultimately show "2 / 2^n = prob (inversion -` {x} \<inter> space (uniform_count_measure dc_crypto))"
      using `0 < n`
      by (simp add: card_inversion card_dc_crypto finite_dc_crypto
                    subset_eq space_uniform_count_measure measure_uniform_count_measure)
  qed

  show "simple_distributed (uniform_count_measure dc_crypto) payer (\<lambda>x. 1 / real n)"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) payer"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix z assume "z \<in> payer ` space (uniform_count_measure dc_crypto)"
    then have "payer -` {z} \<inter> dc_crypto = {z} \<times> {xs. length xs = n}"
      by (auto simp: dc_crypto payer_def space_uniform_count_measure)
    hence "card (payer -` {z} \<inter> dc_crypto) = 2^n"
      using card_lists_length_eq[where A="UNIV::bool set"]
      by (simp add: card_cartesian_product_singleton)
    then show "1 / real n = prob (payer -` {z} \<inter> space (uniform_count_measure dc_crypto))"
      using finite_dc_crypto
      by (subst measure_uniform_count_measure) (auto simp add: card_dc_crypto space_uniform_count_measure)
  qed

  show "simple_distributed (uniform_count_measure dc_crypto) (\<lambda>x. (inversion x, payer x)) (\<lambda>x. 2 / (real n *2^n))"
  proof (rule simple_distributedI)
    show "simple_function (uniform_count_measure dc_crypto) (\<lambda>x. (inversion x, payer x))"
      using finite_dc_crypto
      by (auto simp: simple_function_def space_uniform_count_measure sets_uniform_count_measure)
    fix x assume "x \<in> (\<lambda>x. (inversion x, payer x)) ` space (uniform_count_measure dc_crypto)"
    then obtain i xs where x: "x = (inversion (Some i, xs), payer (Some i, xs))"
      and "i < n" "length xs = n"
      by (simp add: image_iff space_uniform_count_measure dc_crypto Bex_def) blast
    then have xs: "inversion (Some i, xs) \<in> inversion`dc_crypto" and i: "Some i \<in> Some ` {0..<n}"
      and x: "x = (inversion (Some i, xs), Some i)" by (simp_all add: payer_def dc_crypto)
    moreover def ys \<equiv> "inversion (Some i, xs)"
    ultimately have ys: "ys \<in> inversion`dc_crypto"
      and "Some i \<in> Some ` {0..<n}" "x = (ys, Some i)" by simp_all
    then have "(\<lambda>x. (inversion x, payer x)) -` {x} \<inter> space (uniform_count_measure dc_crypto) =
      {dc \<in> dc_crypto. payer dc = Some (the (Some i)) \<and> inversion dc = ys}"
      by (auto simp add: payer_def space_uniform_count_measure)
    then show "2 / (real n * 2 ^ n) = prob ((\<lambda>x. (inversion x, payer x)) -` {x} \<inter> space (uniform_count_measure dc_crypto))"
      using `i < n` ys
      by (simp add: measure_uniform_count_measure card_payer_and_inversion finite_dc_crypto subset_eq card_dc_crypto)
  qed

  show "\<forall>x\<in>space (uniform_count_measure dc_crypto). 2 / (real n * 2 ^ n) = 2 / 2 ^ n * (1 / real n) "
    by simp
qed

end


theory ex_2_11
  imports Main
begin
datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval::"exp \<Rightarrow> int \<Rightarrow> int" where
"eval Var x = x" |
"eval (Const c) x = c" |
"eval (Add exp1 exp2) x = (eval exp1 x) + (eval exp2 x)" |
"eval (Mult exp1 exp2) x = (eval exp1 x) * (eval exp2 x)"

fun evalp::"int list \<Rightarrow> int \<Rightarrow> int" where
"evalp [] _ = 0" |
"evalp (c # cs) x = c + x * (evalp cs x)"

fun addp::"int list \<Rightarrow> int list \<Rightarrow> int list" where
"addp [] ys = ys" |
"addp xs [] = xs" |
"addp (x # xs) (y # ys) = (x + y) # (addp xs ys)"

lemma addp: "evalp (addp p1 p2) x = evalp p1 x + evalp p2 x"
  apply (induction p1 p2 rule:addp.induct)
  by (auto simp add:algebra_simps)

fun multp::"int list \<Rightarrow> int list \<Rightarrow> int list" where
"multp [] ys = []" |
"multp xs [] = []" |
"multp [c] (y # ys) = c * y # (multp [c] ys)" |
"multp (x # xs) ys = addp (multp [x] ys) (multp xs (0 # ys))"

lemma multp: "evalp (multp p1 p2) x = evalp p1 x * evalp p2 x"
  apply (induction p1 p2 rule:multp.induct)
  by (auto simp add:addp algebra_simps)

fun coeffs::"exp \<Rightarrow> int list" where
"coeffs Var = [0, 1]" |
"coeffs (Const c) = [c]" |
"coeffs (Add exp1 exp2) = addp (coeffs exp1) (coeffs exp2)" |
"coeffs (Mult exp1 exp2) = multp (coeffs exp1) (coeffs exp2)"

theorem coeffs: "evalp (coeffs e) x = eval e x"
  apply (induction e)
  by (auto simp add:addp multp)

end


(*  Author:     Tobias Nipkow
    Copyright   1998 TUM
*)

header "Nondeterministic automata"

theory NA
imports AutoProj
begin

type_synonym ('a,'s) na = "'s * ('a => 's => 's set) * ('s => bool)"

primrec delta :: "('a,'s)na => 'a list => 's => 's set" where
"delta A []    p = {p}" |
"delta A (a#w) p = Union(delta A w ` next A a p)"

definition
 accepts :: "('a,'s)na => 'a list => bool" where
"accepts A w = (EX q : delta A w (start A). fin A q)"

definition
 step :: "('a,'s)na => 'a => ('s * 's)set" where
"step A a = {(p,q) . q : next A a p}"

primrec steps :: "('a,'s)na => 'a list => ('s * 's)set" where
"steps A [] = Id" |
"steps A (a#w) = step A a  O  steps A w"

lemma steps_append[simp]:
 "steps A (v@w) = steps A v  O  steps A w"
by(induct v, simp_all add:O_assoc)

lemma in_steps_append[iff]:
  "(p,r) : steps A (v@w) = ((p,r) : (steps A v O steps A w))"
apply(rule steps_append[THEN equalityE])
apply blast
done

lemma delta_conv_steps: "!!p. delta A w p = {q. (p,q) : steps A w}"
by(induct w)(auto simp:step_def)

lemma accepts_conv_steps:
 "accepts A w = (? q. (start A,q) : steps A w & fin A q)"
by(simp add: delta_conv_steps accepts_def)

abbreviation
  Cons_syn :: "'a => 'a list set => 'a list set" (infixr "##" 65) where
  "x ## S == Cons x ` S"

end


(*  Title:      ZF/equalities.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1992  University of Cambridge
*)

section{*Basic Equalities and Inclusions*}

theory equalities imports pair begin

text{*These cover union, intersection, converse, domain, range, etc.  Philippe
de Groote proved many of the inclusions.*}

lemma in_mono: "A\<subseteq>B ==> x\<in>A \<longrightarrow> x\<in>B"
by blast

lemma the_eq_0 [simp]: "(THE x. False) = 0"
by (blast intro: the_0)

subsection{*Bounded Quantifiers*}
text {* \medskip

  The following are not added to the default simpset because
  (a) they duplicate the body and (b) there are no similar rules for @{text Int}.*}

lemma ball_Un: "(\<forall>x \<in> A\<union>B. P(x)) \<longleftrightarrow> (\<forall>x \<in> A. P(x)) & (\<forall>x \<in> B. P(x))"
  by blast

lemma bex_Un: "(\<exists>x \<in> A\<union>B. P(x)) \<longleftrightarrow> (\<exists>x \<in> A. P(x)) | (\<exists>x \<in> B. P(x))"
  by blast

lemma ball_UN: "(\<forall>z \<in> (\<Union>x\<in>A. B(x)). P(z)) \<longleftrightarrow> (\<forall>x\<in>A. \<forall>z \<in> B(x). P(z))"
  by blast

lemma bex_UN: "(\<exists>z \<in> (\<Union>x\<in>A. B(x)). P(z)) \<longleftrightarrow> (\<exists>x\<in>A. \<exists>z\<in>B(x). P(z))"
  by blast

subsection{*Converse of a Relation*}

lemma converse_iff [simp]: "<a,b>\<in> converse(r) \<longleftrightarrow> <b,a>\<in>r"
by (unfold converse_def, blast)

lemma converseI [intro!]: "<a,b>\<in>r ==> <b,a>\<in>converse(r)"
by (unfold converse_def, blast)

lemma converseD: "<a,b> \<in> converse(r) ==> <b,a> \<in> r"
by (unfold converse_def, blast)

lemma converseE [elim!]:
    "[| yx \<in> converse(r);
        !!x y. [| yx=<y,x>;  <x,y>\<in>r |] ==> P |]
     ==> P"
by (unfold converse_def, blast)

lemma converse_converse: "r\<subseteq>Sigma(A,B) ==> converse(converse(r)) = r"
by blast

lemma converse_type: "r\<subseteq>A*B ==> converse(r)\<subseteq>B*A"
by blast

lemma converse_prod [simp]: "converse(A*B) = B*A"
by blast

lemma converse_empty [simp]: "converse(0) = 0"
by blast

lemma converse_subset_iff:
     "A \<subseteq> Sigma(X,Y) ==> converse(A) \<subseteq> converse(B) \<longleftrightarrow> A \<subseteq> B"
by blast

subsection{*Finite Set Constructions Using @{term cons}*}

lemma cons_subsetI: "[| a\<in>C; B\<subseteq>C |] ==> cons(a,B) \<subseteq> C"
by blast

lemma subset_consI: "B \<subseteq> cons(a,B)"
by blast

lemma cons_subset_iff [iff]: "cons(a,B)\<subseteq>C \<longleftrightarrow> a\<in>C & B\<subseteq>C"
by blast

(*A safe special case of subset elimination, adding no new variables
  [| cons(a,B) \<subseteq> C; [| a \<in> C; B \<subseteq> C |] ==> R |] ==> R *)
lemmas cons_subsetE = cons_subset_iff [THEN iffD1, THEN conjE]

lemma subset_empty_iff: "A\<subseteq>0 \<longleftrightarrow> A=0"
by blast

lemma subset_cons_iff: "C\<subseteq>cons(a,B) \<longleftrightarrow> C\<subseteq>B | (a\<in>C & C-{a} \<subseteq> B)"
by blast

(* cons_def refers to Upair; reversing the equality LOOPS in rewriting!*)
lemma cons_eq: "{a} \<union> B = cons(a,B)"
by blast

lemma cons_commute: "cons(a, cons(b, C)) = cons(b, cons(a, C))"
by blast

lemma cons_absorb: "a: B ==> cons(a,B) = B"
by blast

lemma cons_Diff: "a: B ==> cons(a, B-{a}) = B"
by blast

lemma Diff_cons_eq: "cons(a,B) - C = (if a\<in>C then B-C else cons(a,B-C))"
by auto

lemma equal_singleton [rule_format]: "[| a: C;  \<forall>y\<in>C. y=b |] ==> C = {b}"
by blast

(** singletons **)

lemma singleton_subsetI: "a\<in>C ==> {a} \<subseteq> C"
by blast

lemma singleton_subsetD: "{a} \<subseteq> C  ==>  a\<in>C"
by blast

(** succ **)

lemma subset_succI: "i \<subseteq> succ(i)"
by blast

(*But if j is an ordinal or is transitive, then @{term"i\<in>j"} implies @{term"i\<subseteq>j"}!
  See @{text"Ord_succ_subsetI}*)
lemma succ_subsetI: "[| i\<in>j;  i\<subseteq>j |] ==> succ(i)\<subseteq>j"
by (unfold succ_def, blast)

lemma succ_subsetE:
    "[| succ(i) \<subseteq> j;  [| i\<in>j;  i\<subseteq>j |] ==> P |] ==> P"
by (unfold succ_def, blast)

lemma succ_subset_iff: "succ(a) \<subseteq> B \<longleftrightarrow> (a \<subseteq> B & a \<in> B)"
by (unfold succ_def, blast)

subsection{*Binary Intersection*}

(** Intersection is the greatest lower bound of two sets **)

lemma Int_subset_iff: "C \<subseteq> A \<inter> B \<longleftrightarrow> C \<subseteq> A & C \<subseteq> B"
by blast

lemma Int_lower1: "A \<inter> B \<subseteq> A"
by blast

lemma Int_lower2: "A \<inter> B \<subseteq> B"
by blast

lemma Int_greatest: "[| C\<subseteq>A;  C\<subseteq>B |] ==> C \<subseteq> A \<inter> B"
by blast

lemma Int_cons: "cons(a,B) \<inter> C \<subseteq> cons(a, B \<inter> C)"
by blast

lemma Int_absorb [simp]: "A \<inter> A = A"
by blast

lemma Int_left_absorb: "A \<inter> (A \<inter> B) = A \<inter> B"
by blast

lemma Int_commute: "A \<inter> B = B \<inter> A"
by blast

lemma Int_left_commute: "A \<inter> (B \<inter> C) = B \<inter> (A \<inter> C)"
by blast

lemma Int_assoc: "(A \<inter> B) \<inter> C  =  A \<inter> (B \<inter> C)"
by blast

(*Intersection is an AC-operator*)
lemmas Int_ac= Int_assoc Int_left_absorb Int_commute Int_left_commute

lemma Int_absorb1: "B \<subseteq> A ==> A \<inter> B = B"
  by blast

lemma Int_absorb2: "A \<subseteq> B ==> A \<inter> B = A"
  by blast

lemma Int_Un_distrib: "A \<inter> (B \<union> C) = (A \<inter> B) \<union> (A \<inter> C)"
by blast

lemma Int_Un_distrib2: "(B \<union> C) \<inter> A = (B \<inter> A) \<union> (C \<inter> A)"
by blast

lemma subset_Int_iff: "A\<subseteq>B \<longleftrightarrow> A \<inter> B = A"
by (blast elim!: equalityE)

lemma subset_Int_iff2: "A\<subseteq>B \<longleftrightarrow> B \<inter> A = A"
by (blast elim!: equalityE)

lemma Int_Diff_eq: "C\<subseteq>A ==> (A-B) \<inter> C = C-B"
by blast

lemma Int_cons_left:
     "cons(a,A) \<inter> B = (if a \<in> B then cons(a, A \<inter> B) else A \<inter> B)"
by auto

lemma Int_cons_right:
     "A \<inter> cons(a, B) = (if a \<in> A then cons(a, A \<inter> B) else A \<inter> B)"
by auto

lemma cons_Int_distrib: "cons(x, A \<inter> B) = cons(x, A) \<inter> cons(x, B)"
by auto

subsection{*Binary Union*}

(** Union is the least upper bound of two sets *)

lemma Un_subset_iff: "A \<union> B \<subseteq> C \<longleftrightarrow> A \<subseteq> C & B \<subseteq> C"
by blast

lemma Un_upper1: "A \<subseteq> A \<union> B"
by blast

lemma Un_upper2: "B \<subseteq> A \<union> B"
by blast

lemma Un_least: "[| A\<subseteq>C;  B\<subseteq>C |] ==> A \<union> B \<subseteq> C"
by blast

lemma Un_cons: "cons(a,B) \<union> C = cons(a, B \<union> C)"
by blast

lemma Un_absorb [simp]: "A \<union> A = A"
by blast

lemma Un_left_absorb: "A \<union> (A \<union> B) = A \<union> B"
by blast

lemma Un_commute: "A \<union> B = B \<union> A"
by blast

lemma Un_left_commute: "A \<union> (B \<union> C) = B \<union> (A \<union> C)"
by blast

lemma Un_assoc: "(A \<union> B) \<union> C  =  A \<union> (B \<union> C)"
by blast

(*Union is an AC-operator*)
lemmas Un_ac = Un_assoc Un_left_absorb Un_commute Un_left_commute

lemma Un_absorb1: "A \<subseteq> B ==> A \<union> B = B"
  by blast

lemma Un_absorb2: "B \<subseteq> A ==> A \<union> B = A"
  by blast

lemma Un_Int_distrib: "(A \<inter> B) \<union> C  =  (A \<union> C) \<inter> (B \<union> C)"
by blast

lemma subset_Un_iff: "A\<subseteq>B \<longleftrightarrow> A \<union> B = B"
by (blast elim!: equalityE)

lemma subset_Un_iff2: "A\<subseteq>B \<longleftrightarrow> B \<union> A = B"
by (blast elim!: equalityE)

lemma Un_empty [iff]: "(A \<union> B = 0) \<longleftrightarrow> (A = 0 & B = 0)"
by blast

lemma Un_eq_Union: "A \<union> B = \<Union>({A, B})"
by blast

subsection{*Set Difference*}

lemma Diff_subset: "A-B \<subseteq> A"
by blast

lemma Diff_contains: "[| C\<subseteq>A;  C \<inter> B = 0 |] ==> C \<subseteq> A-B"
by blast

lemma subset_Diff_cons_iff: "B \<subseteq> A - cons(c,C)  \<longleftrightarrow>  B\<subseteq>A-C & c \<notin> B"
by blast

lemma Diff_cancel: "A - A = 0"
by blast

lemma Diff_triv: "A  \<inter> B = 0 ==> A - B = A"
by blast

lemma empty_Diff [simp]: "0 - A = 0"
by blast

lemma Diff_0 [simp]: "A - 0 = A"
by blast

lemma Diff_eq_0_iff: "A - B = 0 \<longleftrightarrow> A \<subseteq> B"
by (blast elim: equalityE)

(*NOT SUITABLE FOR REWRITING since {a} == cons(a,0)*)
lemma Diff_cons: "A - cons(a,B) = A - B - {a}"
by blast

(*NOT SUITABLE FOR REWRITING since {a} == cons(a,0)*)
lemma Diff_cons2: "A - cons(a,B) = A - {a} - B"
by blast

lemma Diff_disjoint: "A \<inter> (B-A) = 0"
by blast

lemma Diff_partition: "A\<subseteq>B ==> A \<union> (B-A) = B"
by blast

lemma subset_Un_Diff: "A \<subseteq> B \<union> (A - B)"
by blast

lemma double_complement: "[| A\<subseteq>B; B\<subseteq>C |] ==> B-(C-A) = A"
by blast

lemma double_complement_Un: "(A \<union> B) - (B-A) = A"
by blast

lemma Un_Int_crazy:
 "(A \<inter> B) \<union> (B \<inter> C) \<union> (C \<inter> A) = (A \<union> B) \<inter> (B \<union> C) \<inter> (C \<union> A)"
apply blast
done

lemma Diff_Un: "A - (B \<union> C) = (A-B) \<inter> (A-C)"
by blast

lemma Diff_Int: "A - (B \<inter> C) = (A-B) \<union> (A-C)"
by blast

lemma Un_Diff: "(A \<union> B) - C = (A - C) \<union> (B - C)"
by blast

lemma Int_Diff: "(A \<inter> B) - C = A \<inter> (B - C)"
by blast

lemma Diff_Int_distrib: "C \<inter> (A-B) = (C \<inter> A) - (C \<inter> B)"
by blast

lemma Diff_Int_distrib2: "(A-B) \<inter> C = (A \<inter> C) - (B \<inter> C)"
by blast

(*Halmos, Naive Set Theory, page 16.*)
lemma Un_Int_assoc_iff: "(A \<inter> B) \<union> C = A \<inter> (B \<union> C)  \<longleftrightarrow>  C\<subseteq>A"
by (blast elim!: equalityE)

subsection{*Big Union and Intersection*}

(** Big Union is the least upper bound of a set  **)

lemma Union_subset_iff: "\<Union>(A) \<subseteq> C \<longleftrightarrow> (\<forall>x\<in>A. x \<subseteq> C)"
by blast

lemma Union_upper: "B\<in>A ==> B \<subseteq> \<Union>(A)"
by blast

lemma Union_least: "[| !!x. x\<in>A ==> x\<subseteq>C |] ==> \<Union>(A) \<subseteq> C"
by blast

lemma Union_cons [simp]: "\<Union>(cons(a,B)) = a \<union> \<Union>(B)"
by blast

lemma Union_Un_distrib: "\<Union>(A \<union> B) = \<Union>(A) \<union> \<Union>(B)"
by blast

lemma Union_Int_subset: "\<Union>(A \<inter> B) \<subseteq> \<Union>(A) \<inter> \<Union>(B)"
by blast

lemma Union_disjoint: "\<Union>(C) \<inter> A = 0 \<longleftrightarrow> (\<forall>B\<in>C. B \<inter> A = 0)"
by (blast elim!: equalityE)

lemma Union_empty_iff: "\<Union>(A) = 0 \<longleftrightarrow> (\<forall>B\<in>A. B=0)"
by blast

lemma Int_Union2: "\<Union>(B) \<inter> A = (\<Union>C\<in>B. C \<inter> A)"
by blast

(** Big Intersection is the greatest lower bound of a nonempty set **)

lemma Inter_subset_iff: "A\<noteq>0  ==>  C \<subseteq> \<Inter>(A) \<longleftrightarrow> (\<forall>x\<in>A. C \<subseteq> x)"
by blast

lemma Inter_lower: "B\<in>A ==> \<Inter>(A) \<subseteq> B"
by blast

lemma Inter_greatest: "[| A\<noteq>0;  !!x. x\<in>A ==> C\<subseteq>x |] ==> C \<subseteq> \<Inter>(A)"
by blast

(** Intersection of a family of sets  **)

lemma INT_lower: "x\<in>A ==> (\<Inter>x\<in>A. B(x)) \<subseteq> B(x)"
by blast

lemma INT_greatest: "[| A\<noteq>0;  !!x. x\<in>A ==> C\<subseteq>B(x) |] ==> C \<subseteq> (\<Inter>x\<in>A. B(x))"
by force

lemma Inter_0 [simp]: "\<Inter>(0) = 0"
by (unfold Inter_def, blast)

lemma Inter_Un_subset:
     "[| z\<in>A; z\<in>B |] ==> \<Inter>(A) \<union> \<Inter>(B) \<subseteq> \<Inter>(A \<inter> B)"
by blast

(* A good challenge: Inter is ill-behaved on the empty set *)
lemma Inter_Un_distrib:
     "[| A\<noteq>0;  B\<noteq>0 |] ==> \<Inter>(A \<union> B) = \<Inter>(A) \<inter> \<Inter>(B)"
by blast

lemma Union_singleton: "\<Union>({b}) = b"
by blast

lemma Inter_singleton: "\<Inter>({b}) = b"
by blast

lemma Inter_cons [simp]:
     "\<Inter>(cons(a,B)) = (if B=0 then a else a \<inter> \<Inter>(B))"
by force

subsection{*Unions and Intersections of Families*}

lemma subset_UN_iff_eq: "A \<subseteq> (\<Union>i\<in>I. B(i)) \<longleftrightarrow> A = (\<Union>i\<in>I. A \<inter> B(i))"
by (blast elim!: equalityE)

lemma UN_subset_iff: "(\<Union>x\<in>A. B(x)) \<subseteq> C \<longleftrightarrow> (\<forall>x\<in>A. B(x) \<subseteq> C)"
by blast

lemma UN_upper: "x\<in>A ==> B(x) \<subseteq> (\<Union>x\<in>A. B(x))"
by (erule RepFunI [THEN Union_upper])

lemma UN_least: "[| !!x. x\<in>A ==> B(x)\<subseteq>C |] ==> (\<Union>x\<in>A. B(x)) \<subseteq> C"
by blast

lemma Union_eq_UN: "\<Union>(A) = (\<Union>x\<in>A. x)"
by blast

lemma Inter_eq_INT: "\<Inter>(A) = (\<Inter>x\<in>A. x)"
by (unfold Inter_def, blast)

lemma UN_0 [simp]: "(\<Union>i\<in>0. A(i)) = 0"
by blast

lemma UN_singleton: "(\<Union>x\<in>A. {x}) = A"
by blast

lemma UN_Un: "(\<Union>i\<in> A \<union> B. C(i)) = (\<Union>i\<in> A. C(i)) \<union> (\<Union>i\<in>B. C(i))"
by blast

lemma INT_Un: "(\<Inter>i\<in>I \<union> J. A(i)) =
               (if I=0 then \<Inter>j\<in>J. A(j)
                       else if J=0 then \<Inter>i\<in>I. A(i)
                       else ((\<Inter>i\<in>I. A(i)) \<inter>  (\<Inter>j\<in>J. A(j))))"
by (simp, blast intro!: equalityI)

lemma UN_UN_flatten: "(\<Union>x \<in> (\<Union>y\<in>A. B(y)). C(x)) = (\<Union>y\<in>A. \<Union>x\<in> B(y). C(x))"
by blast

(*Halmos, Naive Set Theory, page 35.*)
lemma Int_UN_distrib: "B \<inter> (\<Union>i\<in>I. A(i)) = (\<Union>i\<in>I. B \<inter> A(i))"
by blast

lemma Un_INT_distrib: "I\<noteq>0 ==> B \<union> (\<Inter>i\<in>I. A(i)) = (\<Inter>i\<in>I. B \<union> A(i))"
by auto

lemma Int_UN_distrib2:
     "(\<Union>i\<in>I. A(i)) \<inter> (\<Union>j\<in>J. B(j)) = (\<Union>i\<in>I. \<Union>j\<in>J. A(i) \<inter> B(j))"
by blast

lemma Un_INT_distrib2: "[| I\<noteq>0;  J\<noteq>0 |] ==>
      (\<Inter>i\<in>I. A(i)) \<union> (\<Inter>j\<in>J. B(j)) = (\<Inter>i\<in>I. \<Inter>j\<in>J. A(i) \<union> B(j))"
by auto

lemma UN_constant [simp]: "(\<Union>y\<in>A. c) = (if A=0 then 0 else c)"
by force

lemma INT_constant [simp]: "(\<Inter>y\<in>A. c) = (if A=0 then 0 else c)"
by force

lemma UN_RepFun [simp]: "(\<Union>y\<in> RepFun(A,f). B(y)) = (\<Union>x\<in>A. B(f(x)))"
by blast

lemma INT_RepFun [simp]: "(\<Inter>x\<in>RepFun(A,f). B(x))    = (\<Inter>a\<in>A. B(f(a)))"
by (auto simp add: Inter_def)

lemma INT_Union_eq:
     "0 \<notin> A ==> (\<Inter>x\<in> \<Union>(A). B(x)) = (\<Inter>y\<in>A. \<Inter>x\<in>y. B(x))"
apply (subgoal_tac "\<forall>x\<in>A. x\<noteq>0")
 prefer 2 apply blast
apply (force simp add: Inter_def ball_conj_distrib)
done

lemma INT_UN_eq:
     "(\<forall>x\<in>A. B(x) \<noteq> 0)
      ==> (\<Inter>z\<in> (\<Union>x\<in>A. B(x)). C(z)) = (\<Inter>x\<in>A. \<Inter>z\<in> B(x). C(z))"
apply (subst INT_Union_eq, blast)
apply (simp add: Inter_def)
done

(** Devlin, Fundamentals of Contemporary Set Theory, page 12, exercise 5:
    Union of a family of unions **)

lemma UN_Un_distrib:
     "(\<Union>i\<in>I. A(i) \<union> B(i)) = (\<Union>i\<in>I. A(i))  \<union>  (\<Union>i\<in>I. B(i))"
by blast

lemma INT_Int_distrib:
     "I\<noteq>0 ==> (\<Inter>i\<in>I. A(i) \<inter> B(i)) = (\<Inter>i\<in>I. A(i)) \<inter> (\<Inter>i\<in>I. B(i))"
by (blast elim!: not_emptyE)

lemma UN_Int_subset:
     "(\<Union>z\<in>I \<inter> J. A(z)) \<subseteq> (\<Union>z\<in>I. A(z)) \<inter> (\<Union>z\<in>J. A(z))"
by blast

(** Devlin, page 12, exercise 5: Complements **)

lemma Diff_UN: "I\<noteq>0 ==> B - (\<Union>i\<in>I. A(i)) = (\<Inter>i\<in>I. B - A(i))"
by (blast elim!: not_emptyE)

lemma Diff_INT: "I\<noteq>0 ==> B - (\<Inter>i\<in>I. A(i)) = (\<Union>i\<in>I. B - A(i))"
by (blast elim!: not_emptyE)

(** Unions and Intersections with General Sum **)

(*Not suitable for rewriting: LOOPS!*)
lemma Sigma_cons1: "Sigma(cons(a,B), C) = ({a}*C(a)) \<union> Sigma(B,C)"
by blast

(*Not suitable for rewriting: LOOPS!*)
lemma Sigma_cons2: "A * cons(b,B) = A*{b} \<union> A*B"
by blast

lemma Sigma_succ1: "Sigma(succ(A), B) = ({A}*B(A)) \<union> Sigma(A,B)"
by blast

lemma Sigma_succ2: "A * succ(B) = A*{B} \<union> A*B"
by blast

lemma SUM_UN_distrib1:
     "(\<Sigma> x \<in> (\<Union>y\<in>A. C(y)). B(x)) = (\<Union>y\<in>A. \<Sigma> x\<in>C(y). B(x))"
by blast

lemma SUM_UN_distrib2:
     "(\<Sigma> i\<in>I. \<Union>j\<in>J. C(i,j)) = (\<Union>j\<in>J. \<Sigma> i\<in>I. C(i,j))"
by blast

lemma SUM_Un_distrib1:
     "(\<Sigma> i\<in>I \<union> J. C(i)) = (\<Sigma> i\<in>I. C(i)) \<union> (\<Sigma> j\<in>J. C(j))"
by blast

lemma SUM_Un_distrib2:
     "(\<Sigma> i\<in>I. A(i) \<union> B(i)) = (\<Sigma> i\<in>I. A(i)) \<union> (\<Sigma> i\<in>I. B(i))"
by blast

(*First-order version of the above, for rewriting*)
lemma prod_Un_distrib2: "I * (A \<union> B) = I*A \<union> I*B"
by (rule SUM_Un_distrib2)

lemma SUM_Int_distrib1:
     "(\<Sigma> i\<in>I \<inter> J. C(i)) = (\<Sigma> i\<in>I. C(i)) \<inter> (\<Sigma> j\<in>J. C(j))"
by blast

lemma SUM_Int_distrib2:
     "(\<Sigma> i\<in>I. A(i) \<inter> B(i)) = (\<Sigma> i\<in>I. A(i)) \<inter> (\<Sigma> i\<in>I. B(i))"
by blast

(*First-order version of the above, for rewriting*)
lemma prod_Int_distrib2: "I * (A \<inter> B) = I*A \<inter> I*B"
by (rule SUM_Int_distrib2)

(*Cf Aczel, Non-Well-Founded Sets, page 115*)
lemma SUM_eq_UN: "(\<Sigma> i\<in>I. A(i)) = (\<Union>i\<in>I. {i} * A(i))"
by blast

lemma times_subset_iff:
     "(A'*B' \<subseteq> A*B) \<longleftrightarrow> (A' = 0 | B' = 0 | (A'\<subseteq>A) & (B'\<subseteq>B))"
by blast

lemma Int_Sigma_eq:
     "(\<Sigma> x \<in> A'. B'(x)) \<inter> (\<Sigma> x \<in> A. B(x)) = (\<Sigma> x \<in> A' \<inter> A. B'(x) \<inter> B(x))"
by blast

(** Domain **)

lemma domain_iff: "a: domain(r) \<longleftrightarrow> (\<exists>y. <a,y>\<in> r)"
by (unfold domain_def, blast)

lemma domainI [intro]: "<a,b>\<in> r ==> a: domain(r)"
by (unfold domain_def, blast)

lemma domainE [elim!]:
    "[| a \<in> domain(r);  !!y. <a,y>\<in> r ==> P |] ==> P"
by (unfold domain_def, blast)

lemma domain_subset: "domain(Sigma(A,B)) \<subseteq> A"
by blast

lemma domain_of_prod: "b\<in>B ==> domain(A*B) = A"
by blast

lemma domain_0 [simp]: "domain(0) = 0"
by blast

lemma domain_cons [simp]: "domain(cons(<a,b>,r)) = cons(a, domain(r))"
by blast

lemma domain_Un_eq [simp]: "domain(A \<union> B) = domain(A) \<union> domain(B)"
by blast

lemma domain_Int_subset: "domain(A \<inter> B) \<subseteq> domain(A) \<inter> domain(B)"
by blast

lemma domain_Diff_subset: "domain(A) - domain(B) \<subseteq> domain(A - B)"
by blast

lemma domain_UN: "domain(\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. domain(B(x)))"
by blast

lemma domain_Union: "domain(\<Union>(A)) = (\<Union>x\<in>A. domain(x))"
by blast

(** Range **)

lemma rangeI [intro]: "<a,b>\<in> r ==> b \<in> range(r)"
apply (unfold range_def)
apply (erule converseI [THEN domainI])
done

lemma rangeE [elim!]: "[| b \<in> range(r);  !!x. <x,b>\<in> r ==> P |] ==> P"
by (unfold range_def, blast)

lemma range_subset: "range(A*B) \<subseteq> B"
apply (unfold range_def)
apply (subst converse_prod)
apply (rule domain_subset)
done

lemma range_of_prod: "a\<in>A ==> range(A*B) = B"
by blast

lemma range_0 [simp]: "range(0) = 0"
by blast

lemma range_cons [simp]: "range(cons(<a,b>,r)) = cons(b, range(r))"
by blast

lemma range_Un_eq [simp]: "range(A \<union> B) = range(A) \<union> range(B)"
by blast

lemma range_Int_subset: "range(A \<inter> B) \<subseteq> range(A) \<inter> range(B)"
by blast

lemma range_Diff_subset: "range(A) - range(B) \<subseteq> range(A - B)"
by blast

lemma domain_converse [simp]: "domain(converse(r)) = range(r)"
by blast

lemma range_converse [simp]: "range(converse(r)) = domain(r)"
by blast

(** Field **)

lemma fieldI1: "<a,b>\<in> r ==> a \<in> field(r)"
by (unfold field_def, blast)

lemma fieldI2: "<a,b>\<in> r ==> b \<in> field(r)"
by (unfold field_def, blast)

lemma fieldCI [intro]:
    "(~ <c,a>\<in>r ==> <a,b>\<in> r) ==> a \<in> field(r)"
apply (unfold field_def, blast)
done

lemma fieldE [elim!]:
     "[| a \<in> field(r);
         !!x. <a,x>\<in> r ==> P;
         !!x. <x,a>\<in> r ==> P        |] ==> P"
by (unfold field_def, blast)

lemma field_subset: "field(A*B) \<subseteq> A \<union> B"
by blast

lemma domain_subset_field: "domain(r) \<subseteq> field(r)"
apply (unfold field_def)
apply (rule Un_upper1)
done

lemma range_subset_field: "range(r) \<subseteq> field(r)"
apply (unfold field_def)
apply (rule Un_upper2)
done

lemma domain_times_range: "r \<subseteq> Sigma(A,B) ==> r \<subseteq> domain(r)*range(r)"
by blast

lemma field_times_field: "r \<subseteq> Sigma(A,B) ==> r \<subseteq> field(r)*field(r)"
by blast

lemma relation_field_times_field: "relation(r) ==> r \<subseteq> field(r)*field(r)"
by (simp add: relation_def, blast)

lemma field_of_prod: "field(A*A) = A"
by blast

lemma field_0 [simp]: "field(0) = 0"
by blast

lemma field_cons [simp]: "field(cons(<a,b>,r)) = cons(a, cons(b, field(r)))"
by blast

lemma field_Un_eq [simp]: "field(A \<union> B) = field(A) \<union> field(B)"
by blast

lemma field_Int_subset: "field(A \<inter> B) \<subseteq> field(A) \<inter> field(B)"
by blast

lemma field_Diff_subset: "field(A) - field(B) \<subseteq> field(A - B)"
by blast

lemma field_converse [simp]: "field(converse(r)) = field(r)"
by blast

(** The Union of a set of relations is a relation -- Lemma for fun_Union **)
lemma rel_Union: "(\<forall>x\<in>S. \<exists>A B. x \<subseteq> A*B) ==>
                  \<Union>(S) \<subseteq> domain(\<Union>(S)) * range(\<Union>(S))"
by blast

(** The Union of 2 relations is a relation (Lemma for fun_Un)  **)
lemma rel_Un: "[| r \<subseteq> A*B;  s \<subseteq> C*D |] ==> (r \<union> s) \<subseteq> (A \<union> C) * (B \<union> D)"
by blast

lemma domain_Diff_eq: "[| <a,c> \<in> r; c\<noteq>b |] ==> domain(r-{<a,b>}) = domain(r)"
by blast

lemma range_Diff_eq: "[| <c,b> \<in> r; c\<noteq>a |] ==> range(r-{<a,b>}) = range(r)"
by blast

subsection{*Image of a Set under a Function or Relation*}

lemma image_iff: "b \<in> r``A \<longleftrightarrow> (\<exists>x\<in>A. <x,b>\<in>r)"
by (unfold image_def, blast)

lemma image_singleton_iff: "b \<in> r``{a} \<longleftrightarrow> <a,b>\<in>r"
by (rule image_iff [THEN iff_trans], blast)

lemma imageI [intro]: "[| <a,b>\<in> r;  a\<in>A |] ==> b \<in> r``A"
by (unfold image_def, blast)

lemma imageE [elim!]:
    "[| b: r``A;  !!x.[| <x,b>\<in> r;  x\<in>A |] ==> P |] ==> P"
by (unfold image_def, blast)

lemma image_subset: "r \<subseteq> A*B ==> r``C \<subseteq> B"
by blast

lemma image_0 [simp]: "r``0 = 0"
by blast

lemma image_Un [simp]: "r``(A \<union> B) = (r``A) \<union> (r``B)"
by blast

lemma image_UN: "r `` (\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. r `` B(x))"
by blast

lemma Collect_image_eq:
     "{z \<in> Sigma(A,B). P(z)} `` C = (\<Union>x \<in> A. {y \<in> B(x). x \<in> C & P(<x,y>)})"
by blast

lemma image_Int_subset: "r``(A \<inter> B) \<subseteq> (r``A) \<inter> (r``B)"
by blast

lemma image_Int_square_subset: "(r \<inter> A*A)``B \<subseteq> (r``B) \<inter> A"
by blast

lemma image_Int_square: "B\<subseteq>A ==> (r \<inter> A*A)``B = (r``B) \<inter> A"
by blast

(*Image laws for special relations*)
lemma image_0_left [simp]: "0``A = 0"
by blast

lemma image_Un_left: "(r \<union> s)``A = (r``A) \<union> (s``A)"
by blast

lemma image_Int_subset_left: "(r \<inter> s)``A \<subseteq> (r``A) \<inter> (s``A)"
by blast

subsection{*Inverse Image of a Set under a Function or Relation*}

lemma vimage_iff:
    "a \<in> r-``B \<longleftrightarrow> (\<exists>y\<in>B. <a,y>\<in>r)"
by (unfold vimage_def image_def converse_def, blast)

lemma vimage_singleton_iff: "a \<in> r-``{b} \<longleftrightarrow> <a,b>\<in>r"
by (rule vimage_iff [THEN iff_trans], blast)

lemma vimageI [intro]: "[| <a,b>\<in> r;  b\<in>B |] ==> a \<in> r-``B"
by (unfold vimage_def, blast)

lemma vimageE [elim!]:
    "[| a: r-``B;  !!x.[| <a,x>\<in> r;  x\<in>B |] ==> P |] ==> P"
apply (unfold vimage_def, blast)
done

lemma vimage_subset: "r \<subseteq> A*B ==> r-``C \<subseteq> A"
apply (unfold vimage_def)
apply (erule converse_type [THEN image_subset])
done

lemma vimage_0 [simp]: "r-``0 = 0"
by blast

lemma vimage_Un [simp]: "r-``(A \<union> B) = (r-``A) \<union> (r-``B)"
by blast

lemma vimage_Int_subset: "r-``(A \<inter> B) \<subseteq> (r-``A) \<inter> (r-``B)"
by blast

(*NOT suitable for rewriting*)
lemma vimage_eq_UN: "f -``B = (\<Union>y\<in>B. f-``{y})"
by blast

lemma function_vimage_Int:
     "function(f) ==> f-``(A \<inter> B) = (f-``A)  \<inter>  (f-``B)"
by (unfold function_def, blast)

lemma function_vimage_Diff: "function(f) ==> f-``(A-B) = (f-``A) - (f-``B)"
by (unfold function_def, blast)

lemma function_image_vimage: "function(f) ==> f `` (f-`` A) \<subseteq> A"
by (unfold function_def, blast)

lemma vimage_Int_square_subset: "(r \<inter> A*A)-``B \<subseteq> (r-``B) \<inter> A"
by blast

lemma vimage_Int_square: "B\<subseteq>A ==> (r \<inter> A*A)-``B = (r-``B) \<inter> A"
by blast

(*Invese image laws for special relations*)
lemma vimage_0_left [simp]: "0-``A = 0"
by blast

lemma vimage_Un_left: "(r \<union> s)-``A = (r-``A) \<union> (s-``A)"
by blast

lemma vimage_Int_subset_left: "(r \<inter> s)-``A \<subseteq> (r-``A) \<inter> (s-``A)"
by blast

(** Converse **)

lemma converse_Un [simp]: "converse(A \<union> B) = converse(A) \<union> converse(B)"
by blast

lemma converse_Int [simp]: "converse(A \<inter> B) = converse(A) \<inter> converse(B)"
by blast

lemma converse_Diff [simp]: "converse(A - B) = converse(A) - converse(B)"
by blast

lemma converse_UN [simp]: "converse(\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. converse(B(x)))"
by blast

(*Unfolding Inter avoids using excluded middle on A=0*)
lemma converse_INT [simp]:
     "converse(\<Inter>x\<in>A. B(x)) = (\<Inter>x\<in>A. converse(B(x)))"
apply (unfold Inter_def, blast)
done

subsection{*Powerset Operator*}

lemma Pow_0 [simp]: "Pow(0) = {0}"
by blast

lemma Pow_insert: "Pow (cons(a,A)) = Pow(A) \<union> {cons(a,X) . X: Pow(A)}"
apply (rule equalityI, safe)
apply (erule swap)
apply (rule_tac a = "x-{a}" in RepFun_eqI, auto)
done

lemma Un_Pow_subset: "Pow(A) \<union> Pow(B) \<subseteq> Pow(A \<union> B)"
by blast

lemma UN_Pow_subset: "(\<Union>x\<in>A. Pow(B(x))) \<subseteq> Pow(\<Union>x\<in>A. B(x))"
by blast

lemma subset_Pow_Union: "A \<subseteq> Pow(\<Union>(A))"
by blast

lemma Union_Pow_eq [simp]: "\<Union>(Pow(A)) = A"
by blast

lemma Union_Pow_iff: "\<Union>(A) \<in> Pow(B) \<longleftrightarrow> A \<in> Pow(Pow(B))"
by blast

lemma Pow_Int_eq [simp]: "Pow(A \<inter> B) = Pow(A) \<inter> Pow(B)"
by blast

lemma Pow_INT_eq: "A\<noteq>0 ==> Pow(\<Inter>x\<in>A. B(x)) = (\<Inter>x\<in>A. Pow(B(x)))"
by (blast elim!: not_emptyE)

subsection{*RepFun*}

lemma RepFun_subset: "[| !!x. x\<in>A ==> f(x) \<in> B |] ==> {f(x). x\<in>A} \<subseteq> B"
by blast

lemma RepFun_eq_0_iff [simp]: "{f(x).x\<in>A}=0 \<longleftrightarrow> A=0"
by blast

lemma RepFun_constant [simp]: "{c. x\<in>A} = (if A=0 then 0 else {c})"
by force

subsection{*Collect*}

lemma Collect_subset: "Collect(A,P) \<subseteq> A"
by blast

lemma Collect_Un: "Collect(A \<union> B, P) = Collect(A,P) \<union> Collect(B,P)"
by blast

lemma Collect_Int: "Collect(A \<inter> B, P) = Collect(A,P) \<inter> Collect(B,P)"
by blast

lemma Collect_Diff: "Collect(A - B, P) = Collect(A,P) - Collect(B,P)"
by blast

lemma Collect_cons: "{x\<in>cons(a,B). P(x)} =
      (if P(a) then cons(a, {x\<in>B. P(x)}) else {x\<in>B. P(x)})"
by (simp, blast)

lemma Int_Collect_self_eq: "A \<inter> Collect(A,P) = Collect(A,P)"
by blast

lemma Collect_Collect_eq [simp]:
     "Collect(Collect(A,P), Q) = Collect(A, %x. P(x) & Q(x))"
by blast

lemma Collect_Int_Collect_eq:
     "Collect(A,P) \<inter> Collect(A,Q) = Collect(A, %x. P(x) & Q(x))"
by blast

lemma Collect_Union_eq [simp]:
     "Collect(\<Union>x\<in>A. B(x), P) = (\<Union>x\<in>A. Collect(B(x), P))"
by blast

lemma Collect_Int_left: "{x\<in>A. P(x)} \<inter> B = {x \<in> A \<inter> B. P(x)}"
by blast

lemma Collect_Int_right: "A \<inter> {x\<in>B. P(x)} = {x \<in> A \<inter> B. P(x)}"
by blast

lemma Collect_disj_eq: "{x\<in>A. P(x) | Q(x)} = Collect(A, P) \<union> Collect(A, Q)"
by blast

lemma Collect_conj_eq: "{x\<in>A. P(x) & Q(x)} = Collect(A, P) \<inter> Collect(A, Q)"
by blast

lemmas subset_SIs = subset_refl cons_subsetI subset_consI
                    Union_least UN_least Un_least
                    Inter_greatest Int_greatest RepFun_subset
                    Un_upper1 Un_upper2 Int_lower1 Int_lower2

ML {*
val subset_cs =
  claset_of (@{context}
    delrules [@{thm subsetI}, @{thm subsetCE}]
    addSIs @{thms subset_SIs}
    addIs  [@{thm Union_upper}, @{thm Inter_lower}]
    addSEs [@{thm cons_subsetE}]);

val ZF_cs = claset_of (@{context} delrules [@{thm equalityI}]);
*}

end