theory LtakeWhile_lmap
  imports Main "$HIPSTER_HOME/IsaHipster"
begin

setup Tactic_Data.set_coinduct_sledgehammer

codatatype (lset: 'a) Llist =
    lnull: LNil
    | LCons (lhd: 'a) (ltl: "'a Llist")
where
 "ltl LNil = LNil"

primcorec ltakeWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a Llist \<Rightarrow> 'a Llist"
where
  "lnull xs \<or> \<not> P (lhd xs) \<Longrightarrow> lnull (ltakeWhile P xs)"
| "lhd (ltakeWhile P xs) = lhd xs"
| "ltl (ltakeWhile P xs) = ltakeWhile P (ltl xs)"

primcorec lmap :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a Llist \<Rightarrow> 'b Llist" where
 "lmap f xs = (case xs of LNil \<Rightarrow> LNil | LCons x xs \<Rightarrow> LCons (f x) (lmap f xs))"

hipster lmap ltakeWhile
lemma lemma_a [thy_expl]: "lmap y (LCons z LNil) = LCons (y z) LNil"
  apply (coinduction  arbitrary: y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
  by simp

lemma lemma_aa [thy_expl]: "LCons (y z) (lmap y x2) = lmap y (LCons z x2)"
  apply (coinduction  arbitrary: x2 y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
by simp

lemma lemma_ab [thy_expl]: "ltakeWhile y (ltakeWhile y z) = ltakeWhile y z"
apply (coinduction  arbitrary: y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
apply simp
by fastforce

lemma lemma_ac [thy_expl]: "ltakeWhile z (ltakeWhile y x2) = ltakeWhile y (ltakeWhile z x2)"
apply (coinduction  arbitrary: x2 y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
apply simp
by fastforce

lemma lemma_ad [thy_expl]: "ltakeWhile y (ltl (ltakeWhile y z)) = ltl (ltakeWhile y z)"
apply (coinduction  arbitrary: y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
apply simp
by (metis (mono_tags, lifting) Llist.sel(2) lemma_ab lnull_def ltakeWhile.ctr(1) ltakeWhile.simps(4))

lemma lemma_ae [thy_expl]: "ltakeWhile y (LCons z (ltakeWhile y x2)) = ltakeWhile y (LCons z x2)"
apply (coinduction  arbitrary: x2 y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
by (simp_all add: lemma_ab)

lemma lemma_af [thy_expl]: "ltl (lmap y z) = lmap y (ltl z)"
apply (coinduction  arbitrary: y z rule: LtakeWhile_lmap.Llist.coinduct_strong)
apply simp
by (smt Llist.collapse(2) Llist.disc_eq_case(1) Llist.sel(1) Llist.sel(2) Llist.sel(3) Llist.simps(5) lmap.code lmap.ctr(1) lnull_def)

lemma unknown [thy_expl]: "ltl (ltl (ltakeWhile y z)) = ltl (ltakeWhile y (ltl z))"
oops

lemma ltakeWhile_lmap: "ltakeWhile P (lmap f xs) = lmap f (ltakeWhile (P \<circ> f) xs)"
  apply(coinduction arbitrary: P f xs rule: Llist.coinduct_strong)
  by (smt Llist.case_eq_if Llist.sel(1) comp_apply lemma_af lmap.disc_iff(2) lmap.sel(1) ltakeWhile.ctr(2) ltakeWhile.disc_iff(2) ltakeWhile.simps(4))
 (* also works:
apply(coinduction arbitrary: P f xs rule: Llist.coinduct_strong)
    by (smt Llist.case_eq_if comp_apply lmap.disc_iff(2) lmap.sel(1) lmap.sel(2) ltakeWhile.disc(1) ltakeWhile.disc(2) ltakeWhile.simps(3) ltakeWhile.simps(4))
 but hipster_coinduct_sledgehammer just kept running with no results  *)
end


theory Signal
imports Nlist IntExt Hilbert ZF.Univ
begin

consts
  "time" :: "i"
  "sig" :: "i \<Rightarrow> i"
  "BaseChTy" :: "i"

syntax
  "time" :: "i"
translations
  "time" => "CONST int"

syntax
  "sig" :: "i \<Rightarrow> i"        ("(sig'(_'))" [75] 75)
translations
  "sig(A)" \<rightleftharpoons> "CONST int \<rightarrow> A"

axiomatization where
  nat_in_base: "nat:BaseChTy"

definition ChEl :: "i" where
  "ChEl == univ(Union(BaseChTy))"

definition ChTy :: "i" where
  "ChTy == Pow(ChEl)"

definition spair :: "[i, i] \<Rightarrow> i" ("(<_#/_>)") where
  "<a # b> == (lam t:time. <a`t, b`t>)"

definition scons :: "[i, i, i] \<Rightarrow> i" ("([_@>_|/_])") where
  "[a @> l | n] == (lam t:time. ncons(n, a`t, l`t))"

definition snil :: "i" where
  "snil == (lam t:time. nnil)"

definition sapp :: "[i, i, i, i] \<Rightarrow> i" where
  "sapp(n1, n2, l1, l2) == (lam t:time. napp(n1, n2, l1`t, l2`t))"

definition ssnoc :: "[i, i, i] \<Rightarrow> i" ("([_<@_|/_])") where
  "[l <@ a | n] == (lam t:time. nsnoc(n, l`t, a`t))"

definition pri :: "i \<Rightarrow> i" where
  "pri(a) == (lam t:time. fst(a`t))"

definition sec :: "i \<Rightarrow> i" where
  "sec(a) == (lam t:time. snd(a`t))"

lemma add_time_const: "\<lbrakk> \<And>x. x:time \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(auto)
done

theorem sig_mono: "\<lbrakk> A \<subseteq> B \<rbrakk> \<Longrightarrow> sig(A) \<subseteq> sig(B)"
apply(drule Pi_mono)
apply(simp)
done

theorem sig_sub_func: "\<lbrakk> x:(time \<rightarrow> A); \<And>t. t:int \<Longrightarrow> x`t:B \<rbrakk> \<Longrightarrow> x:(time \<rightarrow> B)"
apply(rule Pi_type, simp+)
done

theorem nlist_in_chty: "\<lbrakk> A:ChTy \<rbrakk> \<Longrightarrow> nlist[n]A:ChTy"
apply(simp add: ChTy_def ChEl_def)
apply(auto simp add: nlist_into_univ)
done

theorem prod_in_chty: "\<lbrakk> A:ChTy; B:ChTy \<rbrakk> \<Longrightarrow> A*B:ChTy"
apply(simp add: ChTy_def ChEl_def)
apply(subgoal_tac "A * B \<subseteq> univ(\<Union>BaseChTy) * univ(\<Union>BaseChTy)")
apply(insert product_univ[of "\<Union>BaseChTy"])
apply(simp add: subset_trans)
apply(auto)
done

theorem spair_chel: "\<lbrakk> a:sig(ChEl); b:sig(ChEl) \<rbrakk> \<Longrightarrow> <a # b>:sig(ChEl)"
apply(simp add: spair_def)
apply(subgoal_tac "(\<lambda>t\<in>time. \<langle>a ` t, b ` t\<rangle>) \<in> sig({\<langle>a ` x, b ` x\<rangle> . x \<in> time})")
apply(subgoal_tac "{\<langle>a ` x, b ` x\<rangle> . x \<in> time} \<subseteq> ChEl")
apply(drule sig_mono)
apply(drule subsetD, simp+)
apply(rule RepFun_subset)
apply(subgoal_tac "a`x : ChEl" "b`x : ChEl")
apply(simp add: ChEl_def Pair_in_univ)
apply((simp add: apply_funtype)+)
apply(rule lam_funtype)
done

theorem spair_type: "\<lbrakk> a:sig(A); b:sig(B) \<rbrakk> \<Longrightarrow> <a # b>:sig(A*B)"
apply(simp add: spair_def)
done

theorem scons_type: "\<lbrakk> a:sig(A); l:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> [a @> l|n]:sig(nlist[succ(n)]A)"
apply(simp add: scons_def)
apply(subgoal_tac "(\<lambda>t\<in>time. ncons(n, a ` t, l ` t)) : sig({ncons(n, a ` t, l ` t) . t \<in> time})")
apply(subgoal_tac "{ncons(n, a ` t, l ` t) . t \<in> time} \<subseteq> nlist[succ(n)]A")
apply(drule sig_mono, drule subsetD, simp+)
apply(rule RepFun_subset, simp)
apply(rule lam_funtype)
done

theorem snil_type: "snil:sig(nlist[0]A)"
apply(simp add: snil_def)
apply(subgoal_tac "(\<lambda>t\<in>time. nnil) : sig({nnil . t \<in> time})")
apply(erule sig_sub_func, simp)
apply(rule lam_funtype)
done

theorem sapp_type:
  "\<lbrakk> n1:nat; n2:nat; l1:sig(nlist[n1]A); l2:sig(nlist[n2]A) \<rbrakk> \<Longrightarrow> sapp(n1, n2, l1, l2):sig(nlist[n1 #+ n2]A)"
apply(simp add: sapp_def)
apply(subgoal_tac "(\<lambda>t\<in>time. napp(n1, n2, l1 ` t, l2 ` t)) : sig({napp(n1, n2, l1 ` t, l2 ` t) . t \<in> time})")
apply(subgoal_tac "{napp(n1, n2, l1 ` t, l2 ` t) . t \<in> time} \<subseteq> nlist[n1 #+ n2]A")
apply(drule sig_mono, drule subsetD, simp+)
apply(rule RepFun_subset, simp)
apply(rule lam_funtype)
done

theorem ssnoc_type: "\<lbrakk>  n:nat; a:sig(A); l:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> [l <@ a|n]:sig(nlist[succ(n)]A)"
apply(simp add: ssnoc_def)
apply(subgoal_tac "(\<lambda>t\<in>time. nsnoc(n, l ` t, a ` t)) : sig({nsnoc(n, l ` t, a ` t) . t \<in> time})")
apply(subgoal_tac "{nsnoc(n, l ` t, a ` t) . t \<in> time} \<subseteq> nlist[succ(n)]A")
apply(drule sig_mono, drule subsetD, simp+)
apply(rule RepFun_subset, simp)
apply(rule lam_funtype)
done

theorem ssnoc_type2: "\<lbrakk> a:sig(A); l:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> [l <@ a|n]:sig(nlist[succ(n)]A)"
apply(rule ssnoc_type, simp_all)
apply(rule add_time_const)
apply(drule apply_funtype, simp) back
apply(erule nlist_nat)
done

theorem ssnoc_is_app: "[l <@ a|n] = sapp(n, 1, l, [a @> snil|0])"
apply(simp add: sapp_def ssnoc_def scons_def snil_def)
apply(rule lam_cong, simp)
apply(simp add: ncons_def nnil_def nsnoc_def)
done

theorem spair_iff:
  "\<lbrakk> x1:sig(A); x2:sig(B); x1a:sig(C); x2a:sig(D) \<rbrakk>
    \<Longrightarrow> <x1 # x2> = <x1a # x2a> \<longleftrightarrow> x1 = x1a & x2 = x2a"
apply(auto)
apply(simp add: spair_def)
apply(rule fun_extension, simp+)
apply(subgoal_tac "\<langle>x1 ` x, x2 ` x\<rangle> = \<langle>x1a ` x, x2a ` x\<rangle>", simp)
prefer 2
apply(rule fun_extension, simp+)
apply(simp add: spair_def)
apply(subgoal_tac "\<langle>x1 ` x, x2 ` x\<rangle> = \<langle>x1a ` x, x2a ` x\<rangle>", simp)
apply((drule lam_eqE, simp+)+)
done

theorem spairD:
  "\<lbrakk> <x1 # x2> = <x1a # x2a>; x1:sig(A); x2:sig(B); x1a:sig(C); x2a:sig(D) \<rbrakk>
    \<Longrightarrow> x1 = x1a & x2 = x2a"
apply(insert spair_iff, simp)
done

theorem spair_inject:
  "\<lbrakk> <x1 # x2> = <x1a # x2a>; x1:sig(A); x2:sig(B); x1a:sig(C); x2a:sig(D);
    \<lbrakk> x1 = x1a; x2 = x2a \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(drule spairD, simp+)
done

theorem func_nhd_ntl:
  "\<lbrakk> l:sig(nlist[succ(n)]A) \<rbrakk>
    \<Longrightarrow> l = (lam t:time. ncons(n, (lam t1:time. nhd(l ` t1)) ` t,
                                  (lam t1:time. ntl(succ(n), l`t1))`t ))"
apply(rule fun_extension, simp+)
apply(rule nhd_ntl, simp)
done

lemma napp1_to_nsnoc: "napp(n, 1, l, ncons(0, a, nnil)) = nsnoc(n, l, a)"
apply(simp add: nsnoc_def)
done

theorem func_nfront_nlast:
  "\<lbrakk> l:sig(nlist[succ(n)]A) \<rbrakk>
    \<Longrightarrow> l = sapp(n, 1, (lam t:time. nfront(succ(n), l`t)), [(lam t:time. nlast(l`t)) @> snil |0])"
apply(rule fun_extension, simp)
apply((simp add: snil_def scons_def sapp_def)+)
apply(subst napp1_to_nsnoc)
apply(rule nlistE2)
apply(subgoal_tac "l ` x : nlist[succ(n)]A", simp+)
apply(rule nsnoc_nfront_nlast[THEN sym], simp+)
done

theorem ssnoc_iff:
  "\<lbrakk> a:sig(A); b:sig(B); la:sig(nlist[n]C); lb:sig(nlist[n]E) \<rbrakk>
    \<Longrightarrow> ([la <@ a |n] = [lb <@ b |n]) \<longleftrightarrow> (la = lb & a = b)"
apply(auto)
apply(simp add: ssnoc_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp)
apply(insert nsnoc_iff, simp)
apply(simp add: ssnoc_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp+)
done

theorem scons_iff:
  "\<lbrakk> a:sig(A); b:sig(B); la:sig(nlist[n]C); lb:sig(nlist[n]E) \<rbrakk>
    \<Longrightarrow> ([a @> la |n] = [b @> lb |n]) \<longleftrightarrow> (la = lb & a = b)"
apply(auto)
apply(simp add: scons_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp)
apply(insert ncons_iff, simp)
apply(simp add: scons_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp+)
done

theorem ssnoc_inject:
  "\<lbrakk> ([la <@ a |n] = [lb <@ b |n]); a:sig(A); b:sig(B); la:sig(nlist[n]C); lb:sig(nlist[n]E);
    \<lbrakk>la = lb; a = b\<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(insert ssnoc_iff, simp)
done

theorem scons_inject:
  "\<lbrakk> ([a @> la |n] = [b @> lb |n]); a:sig(A); b:sig(B); la:sig(nlist[n]C); lb:sig(nlist[n]E);
    \<lbrakk>la = lb; a = b\<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(insert scons_iff, simp)
done

theorem scons_iff2:
  "\<lbrakk> a:sig(A); b:sig(B); la:sig(nlist[n]C); lb:sig(nlist[n1]E) \<rbrakk>
    \<Longrightarrow> ([a @> la |n] = [b @> lb |n1]) \<longleftrightarrow> (la = lb & a = b & n = n1)"
apply(auto)
apply(simp add: scons_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp)
apply(insert ncons_iff2, simp)
apply(simp add: scons_def)
apply(rule fun_extension, simp+)
apply(drule lam_eqE, simp+)
apply(rule add_time_const)
apply(simp add: scons_def)
apply(drule lam_eqE, simp+)
done

theorem sapp_snil:
  "\<lbrakk> l:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> sapp(0, n, snil, l) = l"
apply(simp add: sapp_def snil_def)
done

theorem sapp_scons:
  "\<lbrakk> a:sig(A); la:sig(nlist[na]A); lb:sig(nlist[nb]A) \<rbrakk>
    \<Longrightarrow> sapp(succ(na), nb, [a @> la | na], lb) = [a @> sapp(na, nb, la, lb) | (na #+ nb)]"
apply(simp add: sapp_def scons_def)
done

theorem scons_ssnoc: "\<lbrakk> a:sig(A) \<rbrakk> \<Longrightarrow> [a @> snil |0] = [snil <@ a |0]"
apply(simp add: snil_def scons_def ssnoc_def)
apply(rule fun_extension, simp+)
apply(rule ncons_nsnoc, simp)
done

lemma choose_func_type: "\<lbrakk> ALL t:int. EX x:B. P(x, t) \<rbrakk> \<Longrightarrow> (\<lambda>t1\<in>int. Choose({x \<in> B . P(x, t1)})) \<in> sig(B)"
apply(insert lam_funtype[of time "%t. Choose({x:B. P(x, t)})"])
apply(subgoal_tac "{Choose({xa \<in> B . P(xa, x)}) . x \<in> int} \<subseteq> B")
apply(frule sig_mono, auto)
apply(subgoal_tac "{x \<in> B . P(x, _)} \<noteq> 0")
apply(insert Choose_def[of "{a \<in> B . P(a, _)}"], auto)
done

lemma only_itself_set: "a:A \<Longrightarrow> c:{x:A. x=a} \<Longrightarrow> c = a"
apply(auto)
done

lemma choosing_its_own: "a:A \<Longrightarrow> a = Choose({x:A. x=a})"
apply(frule only_itself_set)
apply(insert Choose_def[of "{x \<in> A . x = a}"])
apply(subgoal_tac "{x \<in> A . x = a} \<noteq> 0", assumption, simp_all)
apply(auto)
done

theorem sig_pairE: "\<lbrakk> c:sig(A*B); \<And>a b. \<lbrakk> c = <a # b>; a:sig(A); b:sig(B) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(simp add: spair_def)
apply(subgoal_tac
      "c = (\<lambda>t\<in>int.
        \<langle> (\<lambda>t1\<in>time. Choose({x:A. x = fst(c`t1)})) ` t,
          (\<lambda>t1\<in>time. Choose({x:B. x = snd(c`t1)})) ` t\<rangle>)")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({x:A. x = fst(c`t1)})) : sig(A)")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({x:B. x = snd(c`t1)})) : sig(B)")
apply(assumption)
apply(rule choose_func_type, auto)
apply(rule choose_func_type, auto)
apply(rule fun_extension, simp+)
apply(subst Pair_fst_snd_eq[of "c`_" A, THEN sym])
apply(frule apply_funtype, simp+, auto)
apply((rule choosing_its_own, simp)+)
done

theorem sig_nlist0E: "\<lbrakk> c:sig(nlist[0]A); c=snil \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(simp add: snil_def)
apply(subgoal_tac "c = (\<lambda>t\<in>int. nnil)", simp)
apply(rule fun_extension, simp+)
apply(frule apply_funtype, simp)
apply(erule nlistE2, simp+)
done

theorem sig_nlistE:
  "\<lbrakk> c:sig(nlist[succ(n)]A); \<And>a l. \<lbrakk> c = [a @> l | n]; a:sig(A); l:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(simp add: scons_def)
apply(subgoal_tac
      "c = (\<lambda>t\<in>int.
        ncons(n, (\<lambda>t1\<in>time. Choose({x:A. x = nhd(c`t1)})) ` t,
          (\<lambda>t1\<in>time. Choose({x:nlist[n]A. x = ntl(succ(n), c`t1)})) ` t))")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({x:A. x = nhd(c`t1)})) : sig(A)")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({x:nlist[n]A. x = ntl(succ(n), c`t1)})) : sig(nlist[n]A)")
apply(assumption)
apply(rule choose_func_type, auto)
apply(rule choose_func_type, auto)
apply(rule fun_extension, simp+)
apply(frule apply_funtype, simp)
apply(erule nlistE2, simp+)
apply(subst ncons_iff, simp)
apply(subgoal_tac "l = Choose({x \<in> nlist[n']A . x = l})", simp)
apply(rule choosing_its_own, simp, auto)
apply((rule choosing_its_own, simp)+)
done

lemma nfront_nlast: "\<lbrakk> l:nlist[succ(n)]A \<rbrakk> \<Longrightarrow> l = nsnoc(n, nfront(succ(n), l), nlast(l))"
apply(rule nlistE2, simp+)
apply(rule nsnoc_nfront_nlast[THEN sym], simp+)
done

theorem sig_ssnocE:
  "\<lbrakk> x:sig(nlist[succ(n)]A); \<And>a l. \<lbrakk> a:sig(A); l:sig(nlist[n]A); x= [l <@ a |n] \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(simp add: ssnoc_def)
apply(subgoal_tac
      "x = (\<lambda>t\<in>int.
        nsnoc(n, (\<lambda>t1\<in>time. Choose({l:nlist[n]A. l = nfront(succ(n), x`t1)})) ` t,
          (\<lambda>t1\<in>time. Choose({l:A. l = nlast(x`t1)})) ` t))")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({l:A. l = nlast(x`t1)})) : sig(A)")
apply(subgoal_tac "(\<lambda>t1\<in>time. Choose({l:nlist[n]A. l = nfront(succ(n), x`t1)})) : sig(nlist[n]A)")
apply(assumption)
apply(rule choose_func_type, auto)
apply(rule choose_func_type, auto)
apply(rule fun_extension, simp+)
apply(frule apply_funtype, simp)
apply(subst nfront_nlast, simp)
apply(subst nsnoc_iff)
apply(erule nfront_type2, auto)
apply(subgoal_tac "nfront(succ(n), x ` xa) = Choose({l \<in> nlist[n]A . l = nfront(succ(n), x ` xa)})")
apply(simp, erule nfront_type2)
apply((rule choosing_its_own, simp)+)
done

theorem pri_iff: "\<lbrakk> a:sig(A) \<rbrakk> \<Longrightarrow> pri(<a # b>) = a"
apply(simp add: spair_def pri_def)
done

theorem sec_iff: "\<lbrakk> b:sig(B) \<rbrakk> \<Longrightarrow> sec(<a # b>) = b"
apply(simp add: spair_def sec_def)
done

lemmas signal_simps = pri_iff sec_iff scons_iff ssnoc_iff
lemmas signalE =
  spair_inject scons_inject ssnoc_inject sig_pairE
  sig_nlist0E sig_ssnocE succ_nlist zero_nlist
  ncons_inject nsnoc_inject
lemmas signal_types =
  spair_type scons_type snil_type sapp_type ssnoc_type2

lemmas Ruby_type = signal_types Ruby_type
lemmas RubyE = signalE

end


section {*\isaheader{Specification of Unique Priority Queues}*}
theory PrioUniqueSpec
imports ICF_Spec_Base
begin

(*@intf PrioUnique
  @abstype ('e \<rightharpoonup> 'a::linorder)
  Priority queues without duplicate elements. This interface defines a
  decrease-key operation.
*)

text {*
  We define unique priority queues, where each element may occur at most once.
  We provide operations to get and remove the element with the minimum priority,
  as well as to access and change an elements priority (decrease-key operation).

  Unique priority queues are abstracted to maps from elements to priorities.
*}
locale uprio =
  fixes \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes invar :: "'s \<Rightarrow> bool"

locale uprio_no_invar = uprio +
  assumes invar[simp, intro!]: "\<And>s. invar s"

locale uprio_finite = uprio +
  assumes finite_correct:
  "invar s \<Longrightarrow> finite (dom (\<alpha> s))"

subsection "Basic Upriority Queue Functions"

subsubsection "Empty Queue"
locale uprio_empty = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes empty :: "unit \<Rightarrow> 's"
  assumes empty_correct:
  "invar (empty ())"
  "\<alpha> (empty ()) = Map.empty"

subsubsection "Emptiness Predicate"
locale uprio_isEmpty = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes isEmpty :: "'s \<Rightarrow> bool"
  assumes isEmpty_correct:
  "invar s \<Longrightarrow> (isEmpty s) = (\<alpha> s = Map.empty)"

subsubsection "Find and Remove Minimal Element"
locale uprio_pop = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes pop :: "'s \<Rightarrow> ('e \<times> 'a \<times> 's)"
  assumes pop_correct:
  "\<lbrakk>invar s; \<alpha> s \<noteq> Map.empty; pop s = (e,a,s')\<rbrakk> \<Longrightarrow>
    invar s' \<and>
    \<alpha> s' = (\<alpha> s)(e := None) \<and>
    (\<alpha> s) e = Some a \<and>
    (\<forall>y \<in> ran (\<alpha> s). a \<le> y)"
begin

  lemma popE:
    assumes
    "invar s"
    "\<alpha> s \<noteq> Map.empty"
    obtains e a s' where
    "pop s = (e, a, s')"
    "invar s'"
    "\<alpha> s' = (\<alpha> s)(e := None)"
    "(\<alpha> s) e = Some a"
    "(\<forall>y \<in> ran (\<alpha> s). a \<le> y)"
    using assms
    apply (cases "pop s")
    apply (drule (2) pop_correct)
    apply blast
    done

end

subsubsection "Insert"
text {*
  If an existing element is inserted, its priority will be overwritten.
  This can be used to implement a decrease-key operation.
*}
(* TODO: Implement decrease-key generic algorithm, and specify decrease-key operation here! *)
locale uprio_insert = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes insert :: "'s \<Rightarrow> 'e \<Rightarrow> 'a \<Rightarrow> 's"
  assumes insert_correct:
  "invar s \<Longrightarrow> invar (insert s e a)"
  "invar s \<Longrightarrow> \<alpha> (insert s e a) = (\<alpha> s)(e \<mapsto> a)"

subsubsection "Distinct Insert"
text {*
  This operation only allows insertion of elements
  that are not yet in the queue.
*}
locale uprio_distinct_insert = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes insert :: "'s \<Rightarrow> 'e \<Rightarrow> 'a \<Rightarrow> 's"
  assumes distinct_insert_correct:
  "\<lbrakk>invar s; e \<notin> dom (\<alpha> s)\<rbrakk> \<Longrightarrow> invar (insert s e a)"
  "\<lbrakk>invar s; e \<notin> dom (\<alpha> s)\<rbrakk> \<Longrightarrow> \<alpha> (insert s e a) = (\<alpha> s)(e \<mapsto> a)"

subsubsection "Looking up Priorities"
locale uprio_prio = uprio +
  constrains \<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a::linorder)"
  fixes prio :: "'s \<Rightarrow> 'e \<Rightarrow> 'a option"
  assumes prio_correct:
  "invar s \<Longrightarrow> prio s e = (\<alpha> s) e"

subsection "Record Based Interface"

record ('e, 'a, 's) uprio_ops =
  upr_\<alpha> :: "'s \<Rightarrow> ('e \<rightharpoonup> 'a)"
  upr_invar :: "'s \<Rightarrow> bool"
  upr_empty :: "unit \<Rightarrow> 's"
  upr_isEmpty :: "'s \<Rightarrow> bool"
  upr_insert :: "'s \<Rightarrow> 'e \<Rightarrow> 'a \<Rightarrow> 's"
  upr_pop :: "'s \<Rightarrow> ('e \<times> 'a \<times> 's)"
  upr_prio :: "'s \<Rightarrow> 'e \<Rightarrow> 'a option"

locale StdUprioDefs =
  fixes ops :: "('e,'a::linorder,'s, 'more) uprio_ops_scheme"
begin
  abbreviation \<alpha> where "\<alpha> == upr_\<alpha> ops"
  abbreviation invar where "invar == upr_invar ops"
  abbreviation empty where "empty == upr_empty ops"
  abbreviation isEmpty where "isEmpty == upr_isEmpty ops"
  abbreviation insert where "insert == upr_insert ops"
  abbreviation pop where "pop == upr_pop ops"
  abbreviation prio where "prio == upr_prio ops"
end

locale StdUprio =  StdUprioDefs ops +
  uprio_finite \<alpha> invar +
  uprio_empty \<alpha> invar empty +
  uprio_isEmpty \<alpha> invar isEmpty +
  uprio_insert \<alpha> invar insert +
  uprio_pop \<alpha> invar pop +
  uprio_prio \<alpha> invar prio
  for ops
begin
  lemmas correct =
    finite_correct
    empty_correct
    isEmpty_correct
    insert_correct
    prio_correct
end

locale StdUprio_no_invar = StdUprio + uprio_no_invar \<alpha> invar

end


(*  Title:       Verification components with relational MKA
    Author:      Jonathan Julián Huerta y Munive, 2019
    Maintainer:  Jonathan Julián Huerta y Munive <jjhuertaymunive1@sheffield.ac.uk>
*)

section \<open> Verification components with relational MKA \<close>

text \<open> We show that relations form an antidomain Kleene algebra (hence a modal Kleene
algebra). We use its forward box operator to derive rules in the algebra for weakest
liberal preconditions (wlps) of hybrid programs. Finally, we derive our three methods
for verifying correctness specifications for the continuous dynamics of HS in this setting. \<close>

theory HS_VC_MKA_rel
  imports "../HS_ODEs" "KAD.Modal_Kleene_Algebra"

begin

subsection \<open> Modal Kleene algebra preparation \<close>

context dioid_one_zero (* by Victor Gomes, Georg Struth *)
begin

lemma power_inductl: "z + x \<cdot> y \<le> y \<Longrightarrow> (x ^ n) \<cdot> z \<le> y"
  by(induct n, auto, metis mult.assoc mult_isol order_trans)

lemma power_inductr: "z + y \<cdot> x \<le> y \<Longrightarrow> z \<cdot> (x ^ n) \<le> y"
proof (induct n)
  case 0 show ?case
    using "0.prems" by auto
  case Suc
  {
    fix n
    assume "z + y \<cdot> x \<le> y \<Longrightarrow> z \<cdot> x ^ n \<le> y"
      and "z + y \<cdot> x \<le> y"
    hence "z \<cdot> x ^ n \<le> y"
      by auto
    also have "z \<cdot> x ^ Suc n = z \<cdot> x \<cdot> x ^ n"
      by (metis mult.assoc power_Suc)
    moreover have "... = (z \<cdot> x ^ n) \<cdot> x"
      by (metis mult.assoc power_commutes)
    moreover have "... \<le> y \<cdot> x"
      by (metis calculation(1) mult_isor)
    moreover have "... \<le> y"
      using \<open>z + y \<cdot> x \<le> y\<close> by auto
    ultimately have "z \<cdot> x ^ Suc n \<le> y" by auto
  }
  thus ?case
    by (metis Suc)
qed

end

context antidomain_kleene_algebra
begin

lemma fbox_frame: "d p \<cdot> x \<le> x \<cdot> d p \<Longrightarrow> d q \<le> |x] t \<Longrightarrow> d p \<cdot> d q \<le> |x] (d p \<cdot> d t)"
  using dual.mult_isol_var fbox_add1 fbox_demodalisation3 fbox_simp by auto

lemma plus_inv: "i \<le> |x] i \<Longrightarrow> j \<le> |x] j \<Longrightarrow> (i + j) \<le> |x] (i + j)"
  by (metis ads_d_def dka.dsr5 fbox_simp fbox_subdist join.sup_mono order_trans)

lemma mult_inv: "d i \<le> |x] d i \<Longrightarrow> d j \<le> |x] d j \<Longrightarrow> (d i \<cdot> d j) \<le> |x] (d i \<cdot> d j)"
  using fbox_demodalisation3 fbox_frame fbox_simp by auto

lemma fbox_export1: "ad p + |x] q = |d p \<cdot> x] q"
  using a_d_add_closure addual.ars_r_def fbox_def fbox_mult by auto

lemma fbox_stari: "d p \<le> d i \<Longrightarrow> d i \<le> |x] i \<Longrightarrow> d i \<le> d q \<Longrightarrow> d p \<le> |x\<^sup>\<star>] q"
  by (meson dual_order.trans fbox_iso fbox_star_induct_var)

declare fbox_mult [simp]

definition cond :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" ("if _ then _ else _ fi" [64,64,64] 63)
  where "if p then x else y fi = d p \<cdot> x + ad p \<cdot> y"

lemma fbox_cond_var [simp]: "|if p then x else y fi] q = (ad p + |x] q) \<cdot> (d p + |y] q)"
  using cond_def a_closure' ads_d_def ans_d_def fbox_add2 fbox_export1 by auto

definition loopi :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" ("loop _ inv _ " [64,64] 63)
  where "loop x inv i = x\<^sup>\<star>"

lemma fbox_loopi: "d p \<le> d i \<Longrightarrow> d i \<le> |x] i \<Longrightarrow> d i \<le> d q \<Longrightarrow> d p \<le> |loop x inv i] q"
  unfolding loopi_def using fbox_stari by blast

end

subsection \<open> Relational model \<close> (* by Victor Gomes, Georg Struth *)

interpretation rel_dioid: dioid_one_zero "(\<union>)" "(O)" Id "{}" "(\<subseteq>)" "(\<subset>)"
  by (unfold_locales, auto)

lemma power_is_relpow: "rel_dioid.power X n = X ^^ n"
proof (induct n)
  case 0 show ?case
    by (metis rel_dioid.power_0 relpow.simps(1))
  case Suc thus ?case
    by (metis rel_dioid.power_Suc2 relpow.simps(2))
qed

lemma rel_star_def: "X^* = (\<Union>n. rel_dioid.power X n)"
  by (simp add: power_is_relpow rtrancl_is_UN_relpow)

lemma rel_star_contl: "X O Y^* = (\<Union>n. X O rel_dioid.power Y n)"
by (metis rel_star_def relcomp_UNION_distrib)

lemma rel_star_contr: "X^* O Y = (\<Union>n. (rel_dioid.power X n) O Y)"
by (metis rel_star_def relcomp_UNION_distrib2)

interpretation rel_ka: kleene_algebra "(\<union>)" "(O)" Id "{}" "(\<subseteq>)" "(\<subset>)" rtrancl
proof
  fix x y z :: "'a rel"
  show "Id \<union> x O x\<^sup>* \<subseteq> x\<^sup>*"
    by (metis order_refl r_comp_rtrancl_eq rtrancl_unfold)
next
  fix x y z :: "'a rel"
  assume "z \<union> x O y \<subseteq> y"
  thus "x\<^sup>* O z \<subseteq> y"
    by (simp only: rel_star_contr, metis (lifting) SUP_le_iff rel_dioid.power_inductl)
next
  fix x y z :: "'a rel"
  assume "z \<union> y O x \<subseteq> y"
  thus "z O x\<^sup>* \<subseteq> y"
    by (simp only: rel_star_contl, metis (lifting) SUP_le_iff rel_dioid.power_inductr)
qed

definition rel_ad :: "'a rel \<Rightarrow> 'a rel" where
  "rel_ad R = {(x,x) | x. \<not> (\<exists>y. (x,y) \<in> R)}"

interpretation rel_aka: antidomain_kleene_algebra rel_ad "(\<union>)" "(O)" Id "{}" "(\<subseteq>)" "(\<subset>)" rtrancl
  by  unfold_locales (auto simp: rel_ad_def)

subsection \<open> Store and weakest preconditions \<close>

type_synonym 'a pred = "'a \<Rightarrow> bool"

no_notation Archimedean_Field.ceiling ("\<lceil>_\<rceil>")
        and Range_Semiring.antirange_semiring_class.ars_r ("r")
        and antidomain_semiringl.ads_d ("d")

notation Id ("skip")
     and relcomp (infixl ";" 70)
     and zero_class.zero ("0")
     and rel_aka.fbox ("wp")

definition p2r :: "'a pred \<Rightarrow> 'a rel" ("(1\<lceil>_\<rceil>)") where
  "\<lceil>P\<rceil> = {(s,s) |s. P s}"

lemma p2r_simps[simp]:
  "\<lceil>P\<rceil> \<le> \<lceil>Q\<rceil> = (\<forall>s. P s \<longrightarrow> Q s)"
  "(\<lceil>P\<rceil> = \<lceil>Q\<rceil>) = (\<forall>s. P s = Q s)"
  "(\<lceil>P\<rceil> ; \<lceil>Q\<rceil>) = \<lceil>\<lambda> s. P s \<and> Q s\<rceil>"
  "(\<lceil>P\<rceil> \<union> \<lceil>Q\<rceil>) = \<lceil>\<lambda> s. P s \<or> Q s\<rceil>"
  "rel_ad \<lceil>P\<rceil> = \<lceil>\<lambda>s. \<not> P s\<rceil>"
  "rel_aka.ads_d \<lceil>P\<rceil> = \<lceil>P\<rceil>"
  unfolding p2r_def rel_ad_def rel_aka.ads_d_def by auto

lemma wp_rel: "wp R \<lceil>P\<rceil> = \<lceil>\<lambda> x. \<forall> y. (x,y) \<in> R \<longrightarrow> P y\<rceil>"
  unfolding rel_aka.fbox_def p2r_def rel_ad_def by auto

definition vec_upd :: "('a^'b) \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'a^'b"
  where "vec_upd s i a = (\<chi> j. ((($) s)(i := a)) j)"

definition assign :: "'b \<Rightarrow> ('a^'b \<Rightarrow> 'a) \<Rightarrow> ('a^'b) rel" ("(2_ ::= _)" [70, 65] 61)
  where "(x ::= e) = {(s, vec_upd s x (e s))| s. True}"

lemma wp_assign [simp]: "wp (x ::= e) \<lceil>Q\<rceil> = \<lceil>\<lambda>s. Q (\<chi> j. ((($) s)(x := (e s))) j)\<rceil>"
  unfolding wp_rel vec_upd_def assign_def by (auto simp: fun_upd_def)

abbreviation cond_sugar :: "'a pred \<Rightarrow> 'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel" ("IF _ THEN _ ELSE _" [64,64] 63)
  where "IF P THEN X ELSE Y \<equiv> rel_aka.cond \<lceil>P\<rceil> X Y"

abbreviation loopi_sugar :: "'a rel \<Rightarrow> 'a pred \<Rightarrow> 'a rel" ("LOOP _ INV _ " [64,64] 63)
  where "LOOP R INV I \<equiv> rel_aka.loopi R \<lceil>I\<rceil>"

lemma wp_loopI: "\<lceil>P\<rceil> \<le> \<lceil>I\<rceil> \<Longrightarrow> \<lceil>I\<rceil> \<le> \<lceil>Q\<rceil> \<Longrightarrow> \<lceil>I\<rceil> \<le> wp R \<lceil>I\<rceil> \<Longrightarrow> \<lceil>P\<rceil> \<le> wp (LOOP R INV I) \<lceil>Q\<rceil>"
  using rel_aka.fbox_loopi[of "\<lceil>P\<rceil>"] by auto

subsection \<open> Verification of hybrid programs \<close>

text \<open>Verification by providing evolution\<close>

definition g_evol :: "(('a::ord) \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b pred \<Rightarrow> 'a set \<Rightarrow> 'b rel" ("EVOL")
  where "EVOL \<phi> G T = {(s,s') |s s'. s' \<in> g_orbit (\<lambda>t. \<phi> t s) G T}"

lemma wp_g_dyn[simp]:
  fixes \<phi> :: "('a::preorder) \<Rightarrow> 'b \<Rightarrow> 'b"
  shows "wp (EVOL \<phi> G T) \<lceil>Q\<rceil> = \<lceil>\<lambda>s. \<forall>t\<in>T. (\<forall>\<tau>\<in>down T t. G (\<phi> \<tau> s)) \<longrightarrow> Q (\<phi> t s)\<rceil>"
  unfolding wp_rel g_evol_def g_orbit_eq by auto

text \<open>Verification by providing solutions\<close>

definition g_ode :: "(('a::banach)\<Rightarrow>'a) \<Rightarrow> 'a pred \<Rightarrow> real set \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow>
  'a rel" ("(1x\<acute>=_ & _ on _ _ @ _)")
  where "(x\<acute>= f & G on T S @ t\<^sub>0) = {(s,s') |s s'. s' \<in> g_orbital f G T S t\<^sub>0 s}"

lemma wp_g_orbital: "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil> =
  \<lceil>\<lambda> s. \<forall>X\<in>Sols (\<lambda>t. f) T S t\<^sub>0 s. \<forall>t\<in>T. (\<forall>\<tau>\<in>down T t. G (X \<tau>)) \<longrightarrow> Q (X t)\<rceil>"
  unfolding g_orbital_eq wp_rel ivp_sols_def g_ode_def by auto

context local_flow
begin

lemma wp_g_ode: "wp (x\<acute>= f & G on T S @ 0) \<lceil>Q\<rceil> =
  \<lceil>\<lambda> s. s \<in> S \<longrightarrow> (\<forall>t\<in>T. (\<forall>\<tau>\<in>down T t. G (\<phi> \<tau> s)) \<longrightarrow> Q (\<phi> t s))\<rceil>"
  unfolding wp_g_orbital
  apply(clarsimp, safe)
    apply(erule_tac x="\<lambda>t. \<phi> t s" in ballE)
  using in_ivp_sols
     apply(force, force, force simp: init_time ivp_sols_def)
  apply(subgoal_tac "\<forall>\<tau>\<in>down T t. X \<tau> = \<phi> \<tau> s", simp_all, clarsimp)
  apply(subst eq_solution, simp_all add: ivp_sols_def)
  using init_time by auto

lemma fbox_g_ode_ivl: "t \<ge> 0 \<Longrightarrow> t \<in> T \<Longrightarrow> wp (x\<acute>=f & G on {0..t} S @ 0) \<lceil>Q\<rceil> =
  \<lceil>\<lambda>s. s \<in> S \<longrightarrow> (\<forall>t\<in>{0..t}. (\<forall>\<tau>\<in>{0..t}. G (\<phi> \<tau> s)) \<longrightarrow> Q (\<phi> t s))\<rceil>"
  unfolding wp_g_orbital
  apply(clarsimp, safe)
    apply(erule_tac x="\<lambda>t. \<phi> t s" in ballE, force)
  using in_ivp_sols_ivl
    apply(force simp: closed_segment_eq_real_ivl)
  using in_ivp_sols_ivl
   apply(force simp: ivp_sols_def)
  apply(subgoal_tac "\<forall>t\<in>{0..t}. (\<forall>\<tau>\<in>{0..t}. X \<tau> = \<phi> \<tau> s)", simp, clarsimp)
  apply(subst eq_solution_ivl, simp_all add: ivp_sols_def)
     apply(rule has_vderiv_on_subset, force, force simp: closed_segment_eq_real_ivl)
    apply(force simp: closed_segment_eq_real_ivl)
  using interval_time init_time
   apply (meson is_interval_1 order_trans)
  using init_time by force

lemma wp_orbit: "wp ({(s,s') | s s'. s' \<in> \<gamma>\<^sup>\<phi> s}) \<lceil>Q\<rceil> = \<lceil>\<lambda> s. s \<in> S \<longrightarrow> (\<forall> t \<in> T. Q (\<phi> t s))\<rceil>"
  unfolding orbit_def wp_g_ode g_ode_def[symmetric] by auto

end

text \<open> Verification with differential invariants \<close>

definition g_ode_inv :: "(('a::banach)\<Rightarrow>'a) \<Rightarrow> 'a pred \<Rightarrow> real set \<Rightarrow> 'a set \<Rightarrow>
  real \<Rightarrow> 'a pred \<Rightarrow> 'a rel" ("(1x\<acute>=_ & _ on _ _ @ _ DINV _ )")
  where "(x\<acute>= f & G on T S @ t\<^sub>0 DINV I) = (x\<acute>= f & G on T S @ t\<^sub>0)"

lemma wp_g_orbital_guard:
  assumes "H = (\<lambda>s. G s \<and> Q s)"
  shows "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil> = wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>H\<rceil>"
  unfolding wp_g_orbital using assms by auto

lemma wp_g_orbital_inv:
  assumes "\<lceil>P\<rceil> \<le> \<lceil>I\<rceil>" and "\<lceil>I\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>I\<rceil>" and "\<lceil>I\<rceil> \<le> \<lceil>Q\<rceil>"
  shows "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil>"
  using assms(1)
  apply(rule order.trans)
  using assms(2)
  apply(rule order.trans)
  apply(rule rel_aka.fbox_iso)
  using assms(3) by auto

lemma wp_diff_inv[simp]: "(\<lceil>I\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>I\<rceil>) = diff_invariant I f T S t\<^sub>0 G"
  unfolding diff_invariant_eq wp_g_orbital by(auto simp: p2r_def)

lemma diff_inv_guard_ignore:
  assumes "\<lceil>I\<rceil> \<le> wp (x\<acute>= f & (\<lambda>s. True) on T S @ t\<^sub>0) \<lceil>I\<rceil>"
  shows "\<lceil>I\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>I\<rceil>"
  using assms unfolding wp_diff_inv diff_invariant_eq by auto

context local_flow
begin

lemma wp_diff_inv_eq: "diff_invariant I f T S 0 (\<lambda>s. True) =
  (\<lceil>\<lambda>s. s \<in> S \<longrightarrow> I s\<rceil> = wp (x\<acute>= f & (\<lambda>s. True) on T S @ 0) \<lceil>\<lambda>s. s \<in> S \<longrightarrow> I s\<rceil>)"
  unfolding wp_diff_inv[symmetric] wp_g_orbital
  using init_time
  apply(clarsimp simp: ivp_sols_def)
  apply(safe, force, force)
   apply(subst ivp(2)[symmetric], simp)
   apply(erule_tac x="\<lambda>t. \<phi> t s" in allE)
  using in_domain has_vderiv_on_domain ivp(2) init_time by auto

lemma diff_inv_eq_inv_set:
  "diff_invariant I f T S 0 (\<lambda>s. True) = (\<forall>s. I s \<longrightarrow> \<gamma>\<^sup>\<phi> s \<subseteq> {s. I s})"
  unfolding diff_inv_eq_inv_set orbit_def by (auto simp: p2r_def)

end

lemma wp_g_odei: "\<lceil>P\<rceil> \<le> \<lceil>I\<rceil> \<Longrightarrow> \<lceil>I\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>I\<rceil> \<Longrightarrow> \<lceil>\<lambda>s. I s \<and> G s\<rceil> \<le> \<lceil>Q\<rceil> \<Longrightarrow>
  \<lceil>P\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0 DINV I) \<lceil>Q\<rceil>"
  unfolding g_ode_inv_def
  apply(rule_tac b="wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>I\<rceil>" in order.trans)
   apply(rule_tac I="I" in wp_g_orbital_inv, simp_all)
  apply(subst wp_g_orbital_guard, simp)
  by (rule rel_aka.fbox_iso, simp)

subsection \<open> Derivation of the rules of dL \<close>

text\<open> We derive domain specific rules of differential dynamic logic (dL). First we present a
generalised version, then we show the rules as instances of the general ones.\<close>

lemma diff_solve_axiom:
  fixes c::"'a::{heine_borel, banach}"
  assumes "0 \<in> T" and "is_interval T" "open T"
  shows "wp (x\<acute>=(\<lambda>s. c) & G on T UNIV @ 0) \<lceil>Q\<rceil> =
  \<lceil>\<lambda>s. \<forall>t\<in>T. (\<P> (\<lambda>t. s + t *\<^sub>R c) (down T t) \<subseteq> {s. G s}) \<longrightarrow> Q (s + t *\<^sub>R c)\<rceil>"
  apply(subst local_flow.wp_g_ode[where f="\<lambda>s. c" and \<phi>="(\<lambda> t x. x + t *\<^sub>R c)"])
  using line_is_local_flow assms by auto

lemma diff_solve_rule:
  assumes "local_flow f T UNIV \<phi>"
    and "\<forall>s. P s \<longrightarrow> (\<forall> t\<in>T. (\<P> (\<lambda>t. \<phi> t s) (down T t) \<subseteq> {s. G s}) \<longrightarrow> Q (\<phi> t s))"
  shows "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G on T UNIV @ 0) \<lceil>Q\<rceil>"
  using assms by(subst local_flow.wp_g_ode, auto)

lemma diff_weak_axiom:
  "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil> = wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>\<lambda> s. G s \<longrightarrow> Q s\<rceil>"
  unfolding wp_g_orbital image_def by force

lemma diff_weak_rule:
  assumes "\<lceil>G\<rceil> \<le> \<lceil>Q\<rceil>"
  shows "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil>"
  using assms apply(subst wp_rel)
  by(auto simp: g_orbital_eq g_ode_def)

lemma wp_g_evol_IdD:
  assumes "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>C\<rceil> = Id"
    and "\<forall>\<tau>\<in>(down T t). (s, x \<tau>) \<in> (x\<acute>= f & G on T S @ t\<^sub>0)"
  shows "\<forall>\<tau>\<in>(down T t). C (x \<tau>)"
proof
  fix \<tau> assume "\<tau> \<in> (down T t)"
  hence "x \<tau> \<in> g_orbital f G T S t\<^sub>0 s"
    using assms(2) unfolding g_ode_def by blast
  also have "\<forall>y. y \<in> (g_orbital f G T S t\<^sub>0 s) \<longrightarrow> C y"
    using assms(1) unfolding wp_rel g_ode_def by(auto simp: p2r_def)
  ultimately show "C (x \<tau>)"
    by blast
qed

lemma diff_cut_axiom:
  assumes Thyp: "is_interval T" "t\<^sub>0 \<in> T"
    and "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>C\<rceil> = Id"
  shows "wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil> = wp (x\<acute>= f & (\<lambda>s. G s \<and> C s) on T S @ t\<^sub>0) \<lceil>Q\<rceil>"
proof(rule_tac f="\<lambda> x. wp x \<lceil>Q\<rceil>" in HOL.arg_cong, rule subset_antisym)
  show "(x\<acute>=f & G on T S @ t\<^sub>0) \<subseteq> (x\<acute>=f & \<lambda>s. G s \<and> C s on T S @ t\<^sub>0)"
  proof(clarsimp simp: g_ode_def)
    fix s and s' assume "s' \<in> g_orbital f G T S t\<^sub>0 s"
    then obtain \<tau>::real and X where x_ivp: "X \<in> Sols (\<lambda>t. f) T S t\<^sub>0 s"
      and "X \<tau> = s'" and "\<tau> \<in> T" and guard_x:"(\<P> X (down T \<tau>) \<subseteq> {s. G s})"
      using g_orbitalD[of s' "f" G T S t\<^sub>0 s] by blast
    have "\<forall>t\<in>(down T \<tau>). \<P> X (down T t) \<subseteq> {s. G s}"
      using guard_x by (force simp: image_def)
    also have "\<forall>t\<in>(down T \<tau>). t \<in> T"
      using \<open>\<tau> \<in> T\<close> Thyp by auto
    ultimately have "\<forall>t\<in>(down T \<tau>). X t \<in> g_orbital f G T S t\<^sub>0 s"
      using g_orbitalI[OF x_ivp] by (metis (mono_tags, lifting))
    hence "\<forall>t\<in>(down T \<tau>). C (X t)"
      using wp_g_evol_IdD[OF assms(3)] unfolding g_ode_def by blast
    thus "s' \<in> g_orbital f (\<lambda>s. G s \<and> C s) T S t\<^sub>0 s"
      using g_orbitalI[OF x_ivp \<open>\<tau> \<in> T\<close>] guard_x \<open>X \<tau> = s'\<close> by fastforce
  qed
next show "(x\<acute>=f & \<lambda>s. G s \<and> C s on T S @ t\<^sub>0) \<subseteq> (x\<acute>=f & G on T S @ t\<^sub>0)"
    by (auto simp: g_orbital_eq g_ode_def)
qed

lemma diff_cut_rule:
  assumes Thyp: "is_interval T" "t\<^sub>0 \<in> T"
    and wp_C: "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>C\<rceil>"
    and wp_Q: "\<lceil>P\<rceil> \<subseteq> wp (x\<acute>= f & (\<lambda>s. G s \<and> C s) on T S @ t\<^sub>0) \<lceil>Q\<rceil>"
  shows "\<lceil>P\<rceil> \<subseteq> wp (x\<acute>= f & G on T S @ t\<^sub>0) \<lceil>Q\<rceil>"
proof(subst wp_rel, simp add: g_orbital_eq p2r_def g_ode_def, clarsimp)
  fix t::real and X::"real \<Rightarrow> 'a" and s assume "P s" and "t \<in> T"
    and x_ivp:"X \<in> Sols (\<lambda>t. f) T S t\<^sub>0 s"
    and guard_x:"\<forall>x. x \<in> T \<and> x \<le> t \<longrightarrow> G (X x)"
  have "\<forall>t\<in>(down T t). X t \<in> g_orbital f G T S t\<^sub>0 s"
    using g_orbitalI[OF x_ivp] guard_x by auto
  hence "\<forall>t\<in>(down T t). C (X t)"
    using wp_C \<open>P s\<close> by (subst (asm) wp_rel, auto simp: g_ode_def)
  hence "X t \<in> g_orbital f (\<lambda>s. G s \<and> C s) T S t\<^sub>0 s"
    using guard_x \<open>t \<in> T\<close> by (auto intro!: g_orbitalI x_ivp)
  thus "Q (X t)"
    using \<open>P s\<close> wp_Q by (subst (asm) wp_rel) (auto simp: g_ode_def)
qed

text \<open>The rules of dL\<close>

abbreviation g_global_ode ::"(('a::banach)\<Rightarrow>'a) \<Rightarrow> 'a pred \<Rightarrow> 'a rel" ("(1x\<acute>=_ & _)")
  where "(x\<acute>= f & G) \<equiv> (x\<acute>= f & G on UNIV UNIV @ 0)"

abbreviation g_global_ode_inv :: "(('a::banach)\<Rightarrow>'a) \<Rightarrow> 'a pred \<Rightarrow> 'a pred \<Rightarrow> 'a rel"
  ("(1x\<acute>=_ & _ DINV _)") where "(x\<acute>= f & G DINV I) \<equiv> (x\<acute>= f & G on UNIV UNIV @ 0 DINV I)"

lemma DS:
  fixes c::"'a::{heine_borel, banach}"
  shows "wp (x\<acute>=(\<lambda>s. c) & G) \<lceil>Q\<rceil> = \<lceil>\<lambda>x. \<forall>t. (\<forall>\<tau>\<le>t. G (x + \<tau> *\<^sub>R c)) \<longrightarrow> Q (x + t *\<^sub>R c)\<rceil>"
  by (subst diff_solve_axiom[of UNIV]) auto

lemma solve:
  assumes "local_flow f UNIV UNIV \<phi>"
    and "\<forall>s. P s \<longrightarrow> (\<forall>t. (\<forall>\<tau>\<le>t. G (\<phi> \<tau> s)) \<longrightarrow> Q (\<phi> t s))"
  shows "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G) \<lceil>Q\<rceil>"
  apply(rule diff_solve_rule[OF assms(1)])
  using assms(2) by simp

lemma DW: "wp (x\<acute>= f & G) \<lceil>Q\<rceil> = wp (x\<acute>= f & G) \<lceil>\<lambda>s. G s \<longrightarrow> Q s\<rceil>"
  by (rule diff_weak_axiom)

lemma DC:
  assumes "wp (x\<acute>= f & G) \<lceil>C\<rceil> = Id"
  shows "wp (x\<acute>= f & G) \<lceil>Q\<rceil> = wp (x\<acute>= f & (\<lambda>s. G s \<and> C s)) \<lceil>Q\<rceil>"
  apply (rule diff_cut_axiom)
  using assms by auto

lemma dC:
  assumes "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G) \<lceil>C\<rceil>"
    and "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & (\<lambda>s. G s \<and> C s)) \<lceil>Q\<rceil>"
  shows "\<lceil>P\<rceil> \<le> wp (x\<acute>= f & G) \<lceil>Q\<rceil>"
  apply(rule diff_cut_rule)
  using assms by auto

end


(* Section "An Axiom System", right after the class existence theorem. *)

theory axioms_to_infinity
imports class_comprehension auxiliary1
begin

(* page 233, after the proof of the class existence theorem. *)

text{* A definition of the form $x \in X \leftrightarrow \phi(x)$ is done with a proof
       of its definability ("[name]_definable[defining]:"), then an Isabelle definition of a
       metafunction symbol ("[name]") defined using the class  { | }, and then a
       lemma that contains the actual ZF-definition. *}

(* The following is Example 1. *)

lemma cartesian_product_definable[defining]:
shows "definable (\<lambda> x::Set. \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
unfolding definable_def
proof -
  let ?f = "\<lambda> x::Set. \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B"
  let ?\<phi> = "(FEx 10 (FEx 20                                  (* x\<^sub>1\<^sub>0 for u,  x\<^sub>2\<^sub>0 for v    *)
                (FAnd (FAnd
                        (Pair\<phi> 0 10 20)
                        (FBelongs (FVar 10) (FConst A)))
                      (FBelongs (FVar 20) (FConst B)))))"
  have "\<forall>i. FOL_True ?\<phi> i = (?f (i 0))" by (simp add: ordered_pair_def Update_def
     Rep_Set_inject FOL_MaxVar_Dom Pair\<phi>_def ex_definable_lemma2)
  thus "\<exists>\<phi>. \<forall>i. FOL_True \<phi> i = (?f(i(0)))" by blast
qed

definition
  cartesian_product :: "Class \<Rightarrow> Class \<Rightarrow> Class" (infixl "\<times>" 79)
where
  "A \<times> B = {x \<bar> \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B }"

lemma cartesian_product_lemma:
  "\<forall>x. x \<in> (A \<times> B) \<longleftrightarrow> (\<exists>u v. x = \<langle>u,v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
proof
  fix x A B
  from cartesian_product_definable
    have eq: "\<forall>x::Set. x \<in> {x \<bar> \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B }
            \<longleftrightarrow>  (\<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
    using class_comprehension_property by simp
  show "x \<in> (A \<times> B) \<longleftrightarrow> (\<exists>u v. x = \<langle>u,v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
  proof
    assume assm: "x \<in> A \<times> B"
    then have "set(x)" using set_predicate_def by auto
    from assm cartesian_product_def have **: "x \<in> {x \<bar> \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B }"
      by simp
    from eq `set(x)` have "x \<in> {x \<bar> \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B }
            \<longleftrightarrow>  (\<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
      by (metis Abs_Set_inverse assm cartesian_product_def mem_Collect_eq universe)
    with ** show "(\<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B)" by simp
    next
    assume assm: "(\<exists>u v. x = \<langle>u,v\<rangle> \<and> u \<in> A \<and> v \<in> B)"
    then have "set(x)" using Ex4_9_b universe by blast
    from eq `set(x)` have "x \<in> {x \<bar> \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> u \<in> A \<and> v \<in> B }"
      by (metis assm cartesian_product_def)
    with cartesian_product_def show "x \<in> A \<times> B" by simp
  qed
qed

(* abbreviation square :: "Class \<Rightarrow> Class" ("((_)/\<^sup>2)" 90)
  where "Y\<^sup>2 \<equiv> (Y \<times> Y)" *)     (* square is included below, and this becomes a lemma *)

fun n_product :: "Class \<Rightarrow> nat \<Rightarrow> Class" ("(1_)/\<^bsup>(2_)/\<^esup>" 80)
  where "Y\<^bsup>0\<^esup> = \<emptyset>" | "Y\<^bsup>(Suc 0)\<^esup> = Y" | "Y\<^bsup>(Suc (Suc n))\<^esup> = (Y\<^bsup>(Suc n)\<^esup>)\<times>Y"
notation n_product ("(1_)/\<^sup>_" 80)

lemma square: "Y\<^sup>2 \<equiv> (Y \<times> Y)" by (simp add: numeral_2_eq_2)

definition relation_predicate :: "Class \<Rightarrow> bool" ("Rel")
  where "Rel(X) \<longleftrightarrow> X \<subseteq> (\<V>\<^sup>2) "
notation relation_predicate ("(_ is a relation)" 70)

text{* \textbf{FOMUS workshop exercise:} *}

lemma n_product_remark1: "(\<V>\<^sup>2) = { x \<bar> \<exists>u v::Set. x=\<langle>u,v\<rangle> }"
sorry

text{* \textbf{FOMUS workshop extra exercise:} *}

lemma n_product_remark2: "(\<V>\<^sup>n) = { x \<bar> \<exists>i::(nat\<Rightarrow>Set). x = \<langle>\<dots>, i(n)\<rangle> }"
sorry

(* page 234 *)

text{* A definition of the form $x \in X \leftrightarrow \phi(x)$ is done with:
       \begin{enumerate}
       \item a proof that the metafunction \tt{$\lambda x. \phi(x)$} is definable,
       \item the class definition using the \tt{$\{ x \bar \phi(x)\}$} notation, and
       \item a lemma that contains the actual ZF definition using \tt{$x\in X \longleftrightarrow
             \phi(x)$}.
       \end{enumerate}
The first and the last lemma should be the given as \tt{name_definable[defining]} and
\tt{name_lemma}, where \tt{name} is the name of the class defined in step 2. Just as below:
*}

(* Consider extracting formula for subset: Subset\<phi> *)

lemma power_class_definable[defining]:
  shows "definable (\<lambda> x. x \<subseteq> Y)"
proof -
  def "f" == "(\<lambda> x. x \<subseteq> Y)"
  def "\<phi>" == "(FAll 10 (FImp (FBelongs (FVar 10) (FVar 0))
                             (FBelongs (FVar 10) (FConst Y))))"
  {
   fix i
   have "FOL_True \<phi> i = (f (i 0))"
   by ( simp add: f_def ordered_pair_def Update_def
     Rep_Set_inject FOL_MaxVar_Dom \<phi>_def subset)
  }
  then show ?thesis unfolding definable_def f_def by auto
qed

definition
  power_class :: "Class \<Rightarrow> Class" ("\<P>")
  where "\<P>(Y) = {x \<bar> x \<subseteq> Y}"

lemma power_class_lemma: "\<forall>x::Set. (x \<in> \<P>(Y)) \<longleftrightarrow> (x \<subseteq> Y)"
using power_class_def comprehensionE comprehensionI power_class_definable by auto

lemma sum_class_definable: "definable (\<lambda> x. \<exists>v::Set. x \<in> v \<and> v \<in> X)"
proof -
  def "f" == "(\<lambda> x. \<exists>v::Set. x \<in> v \<and> v \<in> X)"
  def "\<phi>" == "(FEx 10 (FAnd  (FBelongs (FVar 0) (FVar 10))
                             (FBelongs (FVar 10) (FConst X))))"
  {
   fix i
   have "FOL_True \<phi> i = (f (i 0))"
   by ( simp add: f_def ordered_pair_def Update_def
     Rep_Set_inject FOL_MaxVar_Dom \<phi>_def)
  }
  then show ?thesis unfolding definable_def f_def by auto
qed

definition
  sum_class :: "Class \<Rightarrow> Class" ("\<Union>")
  where "\<Union>X = {x \<bar> \<exists>v::Set. x \<in> v \<and> v \<in> X }"

lemma sum_class_lemma: "\<forall>x::Set. x \<in> \<Union>X \<longleftrightarrow> (\<exists>v::Set. x \<in> v \<and> v \<in> X)"
by (simp add: class_comprehension_property sum_class_def sum_class_definable)

lemma identity_relation_definable: "definable (\<lambda> x. \<exists>u. x = \<langle>u,u\<rangle>)"
using equals_definable .

definition
  identity_relation :: "Class" ("\<I>")
  where "\<I> = {x \<bar> \<exists>u. x = \<langle>u,u\<rangle>}"

lemma identity_relation_lemma: "\<forall>x::Set. x \<in> \<I> \<longleftrightarrow> (\<exists>u::Set. x = \<langle>u,u\<rangle>)"
by (simp add: class_comprehension_property identity_relation_def identity_relation_definable)

text{* \textbf{FOMUS workshop extra exercise:} *}

lemma Cor4_5: --"Corollary to the class existence theorem."
    fixes n m ::nat
    fixes \<phi> :: FOL_Formula
  assumes "n+m \<le> (FOL_MaxVar \<phi>)"
    shows "\<exists>! W::Class. W \<subseteq> (\<V>\<^sup>n) \<and> (\<forall>i::nat\<Rightarrow>Set. (\<langle>\<dots>,i(n)\<rangle> \<in> W \<longleftrightarrow> (FOL_True \<phi> i)))"
sorry

(* TO DO: Add notation to define classes of tuples by {\<langle>x\<^sub>0, \<dots>, x\<^sub>n\<rangle> \<bar> \<phi>\<langle>x\<^sub>0, \<dots>, x\<^sub>n\<rangle>} *)

(* page 235 *)

(* The following is Example 1 *)

lemma inverse_relation_definable[defining]:
  shows "definable (\<lambda> x::Set. \<exists>u v. x = \<langle>u,v\<rangle> \<and> \<langle>v,u\<rangle> \<in> X)"
unfolding definable_def
proof -
  (* Idea \<langle>v, u\<rangle> \<in> X \<longleftrightarrow> \<exists> z. z = \<langle>v, u\<rangle> \<and> z \<in> X*)
  let ?f = "\<lambda> x::Set. \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> \<langle>v, u\<rangle> \<in> X"
  let ?g = "\<lambda> x::Set. \<exists> u v :: Set. x = \<langle>u, v\<rangle> \<and> (\<exists> z :: Set. z = \<langle>v, u\<rangle> \<and> z \<in> X)"
  have "?f = ?g"  by auto
  let ?\<phi> = "(FEx 10 (FEx 20
                      (FAnd  (Pair\<phi> 0 10 20)
                             (FEx 50 (FAnd (Pair\<phi> 50 20 10)
                                           (FBelongs (FVar 50) (FConst X)))))))"
  have "\<forall>i. FOL_True ?\<phi> i = (?g (i 0))" by (simp add: ordered_pair_def Update_def
     Rep_Set_inject FOL_MaxVar_Dom Pair\<phi>_def ex_definable_lemma2)
  then have "\<forall>i. FOL_True ?\<phi> i = (?f (i 0))" unfolding \<open>?f = ?g\<close> by auto
  then show "\<exists>\<phi>. \<forall>i. FOL_True \<phi> i = (?f (i 0))"  by blast
qed

definition
  inverse_relation :: "Class \<Rightarrow> Class" ("Inv")
  where "Inv(X) = {z \<bar> \<exists>u v. z = \<langle>u,v\<rangle> \<and> \<langle>v,u\<rangle> \<in> X }"

lemma inverse_relation_lemma: "\<langle>x,y\<rangle> \<in> Inv(X) \<longleftrightarrow> \<langle>y,x\<rangle> \<in> X"
proof
  assume "\<langle>x,y\<rangle> \<in> Inv(X)"
  with inverse_relation_def have "\<langle>x,y\<rangle> \<in> { z \<bar> \<exists>u v. z = \<langle>u,v\<rangle> \<and> \<langle>v,u\<rangle> \<in> X }" by simp
  with comprehensionE have "\<exists>u v. \<langle>x,y\<rangle> = \<langle>u,v\<rangle> \<and> \<langle>v,u\<rangle> \<in> X" by auto
  then show "\<langle>y,x\<rangle> \<in> X" using Prop4_3 by blast
  next
  fix y x
  assume "\<langle>y,x\<rangle> \<in> X"
  then have "\<exists>u v. \<langle>x,y\<rangle> = \<langle>u,v\<rangle> \<and> \<langle>v,u\<rangle> \<in> X" by auto
  with comprehensionI inverse_relation_definable inverse_relation_def show "\<langle>x,y\<rangle> \<in> Inv(X)"
    by simp
qed

lemma range_definable[defining]:
  shows "definable (\<lambda>x::Set . \<exists>v.\<langle>v,x\<rangle> \<in> Y)"
proof -
  (* Idea \<exists> v. \<langle>v, x\<rangle> \<in> X \<longleftrightarrow> \<exists> v z. z = \<langle>v, x\<rangle> \<and> z \<in> X*)
  let ?f = "\<lambda> x::Set. \<exists> v :: Set. \<langle>v, x\<rangle> \<in> Y"
  let ?g = "\<lambda> x::Set. \<exists>v :: Set. \<exists>z :: Set. z = \<langle>v,x\<rangle> \<and> z \<in> Y"
  have "?f = ?g" by auto
  let ?\<phi> = "(FEx 10 (* v *)
             (FEx 20 (* z *)
               (FAnd  (Pair\<phi> 20 10 0)
                      (FBelongs (FVar 20) (FConst Y)))))"
  have "\<forall>i. FOL_True ?\<phi> i = (?g (i 0))" by (simp add: ordered_pair_def Update_def Rep_Set_inject
    FOL_MaxVar_Dom Pair\<phi>_def ex_definable_lemma2)
  then have "\<forall>i. FOL_True ?\<phi> i = (?f (i 0))" unfolding \<open>?f = ?g\<close> by auto
  thus ?thesis unfolding definable_def by blast
qed

definition
  range :: "Class \<Rightarrow> Class" ("ran")
  where "ran(Y) = {x \<bar> \<exists>v. \<langle>v,x\<rangle> \<in> Y}"

lemma range_lemma: "\<forall>u::Set. (u \<in> ran(Y)) \<longleftrightarrow> (\<exists>v::Set.\<langle>v,u\<rangle> \<in> Y)"
by (simp add: class_comprehension_property range_def range_definable)

lemma Ex4_12_a: "\<Union>\<emptyset> = \<emptyset>"
proof (unfold set_extensionality)
  show "\<forall>x::Set. x \<in> \<Union> (\<emptyset>) \<longleftrightarrow> x \<in> \<emptyset>"
  proof
    fix x::Set
    have "x \<in> \<Union> (\<emptyset>) \<longleftrightarrow> (\<exists>v::Set. x \<in> v \<and> v \<in> \<emptyset>)" using sum_class_lemma by simp
    then show "x \<in> \<Union> (\<emptyset>) \<longleftrightarrow> x \<in> \<emptyset>" by (simp add:empty_set)
  qed
qed

lemma Ex4_12_b: "\<Union>{\<emptyset>} = \<emptyset>"
proof (unfold set_extensionality)
  show "\<forall>x::Set. x \<in> \<Union>{\<emptyset>} \<longleftrightarrow> x \<in> \<emptyset>"
  proof
    fix x::Set
    have "x \<in> \<Union>{\<emptyset>} \<longleftrightarrow> (\<exists>v::Set. x \<in> v \<and> v \<in> {\<emptyset>})" using sum_class_lemma by simp
    then show "x \<in> \<Union>{\<emptyset>} \<longleftrightarrow> x \<in> \<emptyset>" using empty_set sum_class_def using pairing by auto
  qed
qed

lemma Ex4_12_c: "\<Union>\<V> = \<V>"
using Ex4_9_b Prop4_1_a subset singletonE sum_class_lemma ex_definable_lemma1 by blast

lemma Ex4_12_d: "\<P>(\<V>) = \<V>"
by (meson Ex4_10_c Ex4_10_k Prop4_1_a power_class_lemma subset)

lemma Ex4_12_e: "X \<subseteq> Y \<longrightarrow> (\<Union>X \<subseteq> \<Union>Y \<and> \<P>(X) \<subseteq> \<P>(Y))"
using subset sum_class_lemma by (meson power_class_lemma subset subclass'_def)

lemma Ex4_12_f: "\<Union>(\<P>(X)) = X"
proof (unfold set_extensionality)
  show "\<forall>x::Set. x \<in> \<Union> (\<P> X) \<longleftrightarrow> x \<in> X"
  proof
    fix x::Set
    have "x\<in>\<Union> (\<P> X) \<longleftrightarrow> (\<exists>v::Set. x \<in> v \<and> (v \<subseteq> X))" using sum_class_lemma power_class_lemma
      by simp
    then have "x\<in>\<Union> (\<P> X) \<longleftrightarrow> (x \<in> {x} \<and> ({x} \<subseteq> X))" by (metis pairing subclass'_def)
    then show "x \<in> \<Union> (\<P> X) \<longleftrightarrow> x \<in> X" by (metis pairing subset)
  qed
qed

lemma Ex4_12_g: "X \<subseteq> \<P>(\<Union>X)"
by (meson power_class_lemma subset sum_class_lemma)

lemma Ex4_12_h: "(X \<inter> Y) \<times> (W \<inter> Z) = (X \<times> W) \<inter> (Y \<times> Z)"
proof (rule equalityI)
  show "X \<inter> Y \<times> W \<inter> Z \<subseteq> (X \<times> W) \<inter> (Y \<times> Z)"
  proof (rule subsetI)
    fix x
    assume "x \<in> X \<inter> Y \<times> W \<inter> Z "
    then show "x \<in> (X \<times> W) \<inter> (Y \<times> Z)"
      using B2 cartesian_product_lemma by fastforce
  qed
  show "(X \<times> W) \<inter> (Y \<times> Z) \<subseteq> X \<inter> Y \<times> W \<inter> Z"
  proof (rule subsetI)
    fix x
    assume assm: "x \<in> (X \<times> W) \<inter> (Y \<times> Z)"
    then have "x \<in> X \<times> W" using notin_inter_mono by auto
    from this obtain y z where "x = \<langle>y, z\<rangle>" using cartesian_product_lemma by blast
    with \<open>x \<in> X \<times> W\<close> have "y \<in> X" by (metis B5 cartesian_product_lemma)
    from \<open>x \<in> X \<times> W\<close> \<open>x = \<langle>y, z\<rangle>\<close> have "z \<in> W"
      by (metis Prop4_3 Rep_Set_inject cartesian_product_lemma)
    from assm have "x \<in> Y \<times> Z" using B2 \<open>x \<in> X \<times> W\<close> cartesian_product_lemma by fastforce
    with \<open>x = \<langle>y, z\<rangle>\<close> have "y \<in> Y" by (metis B5 cartesian_product_lemma)
    from \<open>x \<in> Y \<times> Z\<close> \<open>x = \<langle>y,z\<rangle>\<close> have "z \<in> Z"
      by (metis Prop4_3 Rep_Set_inverse cartesian_product_lemma)
    from \<open>y \<in> Y\<close> \<open>y \<in> X\<close> have "y \<in> X \<inter> Y" using B2 by simp
    from \<open>z \<in> W\<close> \<open>z \<in> Z\<close> have "z \<in> W \<inter> Z" using B2 by simp
    with \<open>y \<in> X \<inter> Y\<close> \<open>x = \<langle>y,z\<rangle>\<close> show "x \<in> X \<inter> Y \<times> W \<inter> Z"
      using cartesian_product_lemma by auto
  qed
qed

lemma Ex4_12_i: "(X \<union> Y) \<times> (W \<union> Z) = (X \<times> W) \<union> (X \<times> Z) \<union> (Y \<times> W) \<union> (Y \<times> Z)"
proof (rule equalityI)
  show "X \<union> Y \<times> W \<union> Z \<subseteq> (X \<times> W) \<union> (X \<times> Z) \<union> (Y \<times> W) \<union> (Y \<times> Z)"
  proof (rule subsetI)
    fix x
    assume assm: "x \<in> X \<union> Y \<times> W \<union> Z"
    then obtain y z where xyz: "x = \<langle>y, z\<rangle>" using cartesian_product_lemma by blast
    with assm have "y \<in> X \<union> Y" by (metis Prop4_3 Rep_Set_inverse cartesian_product_lemma)
    then have "y \<in> X \<or> y \<in> Y" by (simp add: Ex4_9_a)
    from assm xyz have "z \<in> W \<union> Z" by (metis Prop4_3 Rep_Set_inverse cartesian_product_lemma)
    then have "z \<in> W \<or> z \<in> Z" by (simp add: Ex4_9_a)
    show "x \<in> (X \<times> W) \<union> (X \<times> Z) \<union> (Y \<times> W) \<union> (Y \<times> Z)"
    proof (cases "y \<in> X")
      assume "y \<in> X"
      then have "x \<in> (X \<times> W) \<union> (X \<times> Z)"
        using \<open>z \<in> W \<or> z \<in> Z\<close> cartesian_product_lemma union_iff_or xyz by blast
      then show ?thesis by (simp add: B2 B3 xyz)
      next
      assume "y \<notin> X"
      then have "y \<in> Y" using \<open>y \<in> X \<or>  y \<in> Y\<close> by blast
      then have "x \<in> (Y \<times> W) \<union> (Y \<times> Z)"
        using \<open>z \<in> W \<or> z \<in> Z\<close> cartesian_product_lemma union_iff_or xyz by blast
      then show ?thesis by (simp add: B2 B3 xyz)
    qed
  qed

  show "(X \<times> W) \<union> (X \<times> Z) \<union> (Y \<times> W) \<union> (Y \<times> Z) \<subseteq> X \<union> Y \<times> W \<union> Z"
  proof (rule subsetI)
    fix x
    assume assm: "x \<in> (X \<times> W) \<union> (X \<times> Z) \<union> (Y \<times> W) \<union> (Y \<times> Z)"
    then obtain y z where "x = \<langle>y,z\<rangle>"
      using cartesian_product_lemma union_iff_or by auto
    from assm have "x \<in> X \<times> W \<or> x \<in> X \<times> Z \<or> x \<in> Y \<times> W \<or> x \<in> Y \<times> Z"
      by (simp add: union_iff_or)
    thus "x \<in> (X \<union> Y) \<times> (W \<union> Z)" using cartesian_product_lemma union_iff_or Ex4_9_c assm
      by fastforce
  qed
qed

lemma Ex4_12_j: "\<P>(X \<inter> Y) = (\<P>(X)) \<inter> \<P>(Y)"
proof (rule equalityI)
  show "\<P>(X \<inter> Y) \<subseteq> (\<P>(X)) \<inter> \<P>(Y)"
  proof (rule subsetI)
    fix x::Set
    assume assm: "x \<in> \<P>(X \<inter> Y)"
    then have "x \<subseteq> X \<inter> Y" using power_class_lemma by simp
    then have "x \<subseteq> X" using B2 subset by blast
    then have 1: "x \<in> \<P>(X)" using power_class_lemma by simp
    from \<open>x \<subseteq> X \<inter> Y\<close> have "x \<subseteq> Y" using B2 subset by blast
    then have 2: "x \<in> \<P>(Y)" using power_class_lemma by simp
    from 1 2 show "x \<in> (\<P>(X)) \<inter> \<P>(Y)" using B2 by simp
  qed

  show "(\<P>(X)) \<inter> \<P>(Y) \<subseteq> \<P>(X \<inter> Y)"
  proof (rule subsetI)
    fix x::Set
    assume assm: "x \<in> (\<P>(X)) \<inter> \<P>(Y)"
    then have "x \<in> \<P>(X)" using B2 by simp
    then have "x \<subseteq> X" using power_class_lemma by simp
    from assm have "x \<in> \<P>(Y)" using B2 by simp
    then have "x \<subseteq> Y" using power_class_lemma by simp
    with \<open>x \<subseteq> X\<close> have "x \<subseteq> X \<inter> Y" using Ex4_10_c Ex4_10_e by metis
    then show "x \<in> \<P>(X \<inter> Y)" using power_class_lemma by simp
  qed
qed

lemma Ex4_12_k: "(\<P>(X)) \<union> \<P>(Y) \<subseteq> \<P>(X \<union> Y)"
proof (rule subsetI)
  fix x::Set
  assume "x \<in> (\<P>(X)) \<union> \<P>(Y)"
  then have "x \<in> \<P>(X) \<or> x \<in> \<P>(Y)" by (simp add: Ex4_9_a)
  then have "x \<subseteq> X \<or> x \<subseteq> Y" using power_class_lemma by simp
  then have "x \<subseteq> X \<union> Y" by (smt Ex4_10_a Ex4_10_d Ex4_10_f)
  then show "x \<in> \<P>(X \<union> Y)" using power_class_lemma by simp
qed

lemma Ex4_12_m: "\<Union>(X\<union>Y) = (\<Union>X) \<union> (\<Union>Y)"
proof (rule equalityI)
  show " \<Union> (X \<union> Y) \<subseteq> \<Union> X \<union> \<Union> Y"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> \<Union>(X \<union> Y)"
    then obtain z::Set where *: "z \<in> X \<union> Y \<and> x \<in> z" using sum_class_lemma by metis
    then have "z \<in> X \<or> z \<in> Y" by (simp add: union_iff_or)
    with * have "x \<in> \<Union>X \<or> x \<in> \<Union>Y" using sum_class_lemma by blast
    then show "x \<in> \<Union> X \<union> \<Union> Y" using union_iff_or by simp
  qed

  show "\<Union> X \<union> \<Union> Y \<subseteq> \<Union> (X \<union> Y)"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> \<Union>X \<union> \<Union>Y"
    then have **: "x \<in> \<Union>X \<or> x \<in> \<Union>Y" using union_iff_or by simp
    show "x \<in> \<Union>(X \<union> Y)"
    proof (cases "x \<in> \<Union>X")
      assume "x \<in> \<Union>X"
      then obtain z::Set where *: "z \<in> X \<and> x \<in> z" using sum_class_lemma by blast
      then have "z \<in> X \<union> Y" using union_iff_or by simp
      with * show "x \<in> \<Union>(X \<union> Y)" using sum_class_lemma by blast
      next
      assume "x \<notin> \<Union>X"
      with ** have "x \<in> \<Union>Y" by simp
      then obtain z::Set where *: "z \<in> Y \<and> x \<in> z" using sum_class_lemma by blast
      then have "z \<in> X \<union> Y" using union_iff_or by simp
      with * show "x \<in> \<Union>(X \<union> Y)" using sum_class_lemma by blast
    qed
  qed
qed

lemma Ex4_12_n: "\<Union>(X\<inter>Y) \<subseteq> (\<Union>X) \<inter> (\<Union>Y)"
proof (rule subsetI)
  fix x::Set
  assume "x \<in> \<Union>(X \<inter> Y)"
  then obtain z::Set where "z \<in> X \<inter> Y \<and> x \<in> z" using sum_class_lemma by blast
  then show "x \<in> \<Union>X \<inter> \<Union>Y" using B2 sum_class_lemma by auto
qed

lemma Ex4_12_o: "Z = Inv(Y) \<longrightarrow> Inv(Z) = Y \<inter> (\<V>\<^sup>2)"
proof
  assume assm: "Z = Inv(Y)"
  have "Z \<subseteq> (\<V>\<^sup>2)"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> Z"
    show "x \<in> (\<V>\<^sup>2)" using Ex4_9_b \<open>Rep_Set x \<in> Z\<close> assm cartesian_product_lemma comprehensionE
      inverse_relation_def cartesian_definable comprehensionI n_product_remark1 by fastforce
  qed
  have a: "\<langle>x,y\<rangle> \<in> Z \<longleftrightarrow> (\<langle>y,x\<rangle> \<in> (Y \<inter> (\<V>\<^sup>2)))"
    using B2 Ex4_9_b assm cartesian_product_lemma inverse_relation_lemma square by auto
  show "Inv(Z) = Y \<inter> (\<V>\<^sup>2)"
  proof (rule equalityI)
    show "Inv(Z) \<subseteq> Y \<inter> (\<V>\<^sup>2)"
    proof (rule subsetI)
      fix x::Set
      assume "x\<in>Inv(Z)"
      show "x\<in>Y \<inter> (\<V>\<^sup>2)" using B2 Ex4_9_b \<open>Rep_Set x \<in> Inv Z\<close> assm cartesian_product_lemma
        comprehensionE inverse_relation_def inverse_relation_lemma square by fastforce
    qed
    show "Y \<inter> (\<V>\<^sup>2) \<subseteq> Inv(Z)"
    proof (rule subsetI)
      fix x::Set
      assume "x\<in>Y \<inter> (\<V>\<^sup>2)"
      show "x\<in>Inv(Z)" using B2 \<open>Rep_Set x \<in> Y \<inter> (\<V>\<^sup>2)\<close> assm cartesian_product_lemma
        inverse_relation_lemma square by auto
    qed
  qed
qed

lemma Ex4_12_p: "Rel(\<I>) \<and> Inv(\<I>) = \<I>"
proof
  show r: "Rel(\<I>)"
  proof (simp add: relation_predicate_def)
    show "\<I> \<subseteq> (\<V>\<^sup>2)"
    proof (rule subsetI)
      fix x::Set
      assume assm: "x\<in>\<I>"
      show "x\<in>(\<V>\<^sup>2)"
      proof -
        from assm obtain u::Set where "x = \<langle>u,u\<rangle>" using Rep_Set_inject identity_relation_lemma by auto
        from this show "x\<in>(\<V>\<^sup>2)" using square Ex4_9_b cartesian_product_lemma by auto
      qed
    qed
  qed

  show "Inv(\<I>) = \<I>"
  proof (rule equalityI)
    show "Inv(\<I>)\<subseteq>\<I>"
    proof (rule subsetI)
      fix x::Set
      assume assm1: "x\<in>Inv(\<I>)"
      from this have "Rel(Inv(\<I>))" by (metis Ex4_10_c Ex4_12_o \<open>Rel \<I>\<close> relation_predicate_def)
      from this have "x\<in>\<V>\<times>\<V>" using assm1 relation_predicate_def subset square by auto
      from this assm1 obtain z y where "x = \<langle>y,z\<rangle>" using Rep_Set_inject cartesian_product_lemma by auto
      from this assm1 have "\<langle>z,y\<rangle>\<in>\<I>" by (simp add: inverse_relation_lemma)
      from this have "z = y" by (metis Class_Ex_Equals1 identity_relation_lemma)
      from this have "x = \<langle>y,y\<rangle>" by (simp add: \<open>x = \<langle>y, z\<rangle>\<close>)
      then show "x\<in>\<I>" using \<open>Rep_Set \<langle>z, y\<rangle> \<in> \<I>\<close> \<open>z = y\<close> by blast
    qed
    show "\<I>\<subseteq>Inv(\<I>)"
    proof (rule subsetI)
      fix x::Set
      assume assm2: "x\<in>\<I>"
      show "x\<in>Inv(\<I>)"
      proof -
        from r assm2 obtain z where "x=\<langle>z,z\<rangle>" using Rep_Set_inject identity_relation_lemma by auto
        with assm2 show "x\<in>Inv(\<I>)" by (simp add: inverse_relation_lemma)
      qed
    qed
  qed
qed

lemma Ex4_12_q: "\<P>(\<emptyset>) = {\<emptyset>}"
proof (rule equalityI)
  show "\<P>(\<emptyset>) \<subseteq> {\<emptyset>}"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> \<P>(\<emptyset>)"
    with power_class_lemma have "x \<subseteq> \<emptyset>" by simp
    then have "x = \<emptyset>" by (simp add: Ex4_10_c Ex4_10_i Rep_Set_inject)
    then show "x \<in> {\<emptyset>}" by (simp add: pairing)
  qed
  show "{\<emptyset>} \<subseteq> \<P>(\<emptyset>)" by (metis Ex4_12_b Ex4_12_g)
qed

lemma Ex4_12_r: "\<P>({\<emptyset>}) = {\<emptyset>, {\<emptyset>}}"
proof (rule equalityI)
  show "\<P>({\<emptyset>}) \<subseteq> {\<emptyset>, {\<emptyset>}}"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> \<P>({\<emptyset>})"
    then have *: "x \<subseteq> {\<emptyset>}" using power_class_lemma by simp
    have "x = \<emptyset> \<or> x = {\<emptyset>}"
    proof (rule ccontr)
      assume "\<not>(x = \<emptyset> \<or> x = {\<emptyset>})"
      then have **: "x \<noteq> \<emptyset> \<and> x \<noteq> {\<emptyset>}" by simp
      then obtain z where ***: "z \<in> x" by (metis Rep_Set_inverse empty_set extensionality)
      with * ** have "z \<noteq> \<emptyset>" by (metis Rep_Set_inject equalityI pairing subsetI)
      from * *** have "z = \<emptyset>" using pairing subclass'_def by blast
      with \<open>z \<noteq> \<emptyset>\<close> show "False" ..
    qed
    then show "x \<in> {\<emptyset>, {\<emptyset>}}" using pairing by auto
  qed
  show "{\<emptyset>, {\<emptyset>}} \<subseteq> \<P>({\<emptyset>})"
  proof (rule subsetI)
    fix x::Set
    assume "x \<in> {\<emptyset>, {\<emptyset>}}"
    then have "x = \<emptyset> \<or> x = {\<emptyset>}" by (simp add: Rep_Set_inject pairing)
    then have "x \<subseteq> {\<emptyset>}" by (metis Ex4_12_a Ex4_12_b Ex4_12_g Ex4_12_q)
    then show "x \<in> \<P>({\<emptyset>})" by (simp add: power_class_lemma)
  qed
qed

lemma Ex4_12_s: "\<forall>x y. x \<times> y \<subseteq> \<P>(\<P>(x \<union> y))"
proof
  fix x
  show " \<forall>y. x \<times> y \<subseteq> \<P>(\<P>(x \<union> y))"
  proof
    fix y
    show "x \<times> y \<subseteq> \<P>(\<P>(x \<union> y))"
    proof (rule subsetI)
      fix z
      assume "z \<in> x \<times> y"
      then obtain z1 z2 where "z = \<langle>z1, z2\<rangle>" "z1 \<in> x" "z2 \<in> y"
        using cartesian_product_lemma by blast
      then have "{z1} \<subseteq> x \<union> y"
        by (metis Ex4_9_a pairing subsetI)
      then have "{z1} \<in> \<P>(x \<union> y)" using power_class_lemma by simp
      from \<open>z1 \<in> x\<close> \<open>z2 \<in> y\<close> have "{z1, z2} \<subseteq> x \<union> y"
        using Ex4_9_a pairing subsetI by presburger
      then have "{z1, z2} \<in> \<P>(x \<union> y)" using power_class_lemma by simp
      with \<open>{z1} \<in> \<P>(x \<union> y)\<close> have "{{z1},{z1,z2}} \<subseteq> \<P>(x \<union> y)"
        using pairing subsetI by presburger
      then have "{{z1},{z1,z2}} \<in> \<P>(\<P>(x \<union> y))"
        using power_class_lemma by simp
      with \<open>z = \<langle>z1,z2\<rangle>\<close> show "z \<in> \<P>(\<P>(x \<union> y))" using ordered_pair_def by simp
    qed
  qed
qed

lemma Ex4_12_t: "Rel(Y) \<longrightarrow> Y \<subseteq> dom(Y) \<times> ran(Y)"
proof (rule impI)
  assume a: "Rel(Y)"
  show "Y \<subseteq> dom(Y) \<times> ran(Y)"
  proof (rule subsetI)
    fix x::Set
    assume "x\<in>Y"
    from this obtain y z where "\<langle>y, z\<rangle> = x" using Rep_Set_inject a cartesian_product_lemma
      square relation_predicate_def subclass'_def by auto
    from this have "y\<in>dom(Y)" using B4 \<open>Rep_Set x \<in> Y\<close> by blast
    moreover have "z\<in>ran(Y)" using \<open>Rep_Set x \<in> Y\<close> \<open>\<langle>y, z\<rangle> = x\<close> range_lemma by auto
    with a \<open>y\<in>dom(Y)\<close> show "x \<in> dom(Y) \<times> ran(Y)" using \<open>\<langle>y, z\<rangle> = x\<close> cartesian_product_lemma
      by blast
  qed
qed

(* page 236 *)

axiomatization
where sum_set:
  "\<forall>x::Set. \<exists>y::Set. \<forall>u::Set. (u\<in>y \<longleftrightarrow> (\<exists>v::Set. u\<in>v \<and> v\<in>x))"

lemma sum_set_remark: "\<forall>x::Set. (\<Union>x is a set)"
proof
  fix x::Set
  obtain y::Set where "\<forall>u::Set.(u\<in>y \<longleftrightarrow> (\<exists>v::Set. u\<in>v \<and> v\<in>x))" using sum_set by blast
  hence "y=\<Union>x" by (simp add: set_extensionality sum_class_lemma)
  thus "(\<Union>x) is a set" by (metis Ex4_9_b universe)
qed

(* Not sure how and if this will be used, but it is in Mendelson.
   I commented it out because it's causing my Isabelle2016 to crash.
   Experiment further. *)
(*abbreviation union_indexed :: "Set \<Rightarrow> Set" ("(\<Union>\<^sub>v\<^sub>\<in>\<^sub>_ v)")
  where "\<Union>\<^sub>v\<^sub>\<in>\<^sub>x v \<equiv> x"*)

lemma Ex4_13_a: "\<forall>x::Set. \<forall>y::Set. (\<Union>{x,y} = x\<union>y)"
proof
  fix x::Set
  show "\<forall>y::Set. (\<Union>{x,y} = x\<union>y)"
  proof
    fix y::Set
    show "\<Union>{x,y} = x\<union>y"
    proof (rule equalityI)
      show "\<Union>{x,y} \<subseteq> x\<union>y"
      proof (rule subsetI)
        fix xa::Set
        assume "xa \<in> \<Union>{x,y}"
        then show "xa \<in> x\<union>y" using pairing sum_class_lemma union_iff_or by auto
      qed
      show "x\<union>y \<subseteq> \<Union>{x,y}"
      proof (rule subsetI)
        fix xa::Set
        assume "xa \<in> x\<union>y"
        then show "xa \<in> \<Union>{x,y}" using pairing sum_class_lemma union_iff_or by auto
      qed
    qed
  qed
qed

lemma Ex4_13_b: "\<forall>x::Set. \<forall>y::Set. set(x\<union>y)"
proof
  fix x::Set
  show "\<forall>y::Set. set(x\<union>y)"
  proof
    fix y::Set
    have "set({x,y})" using Ex4_9_b set_predicate_def by auto
    then have "\<exists>z::Set. \<forall>u::Set. (u\<in>z \<longleftrightarrow> (\<exists>v::Set. u\<in>v \<and> v\<in>{x,y}))" using sum_set by simp
    then obtain z::Set where "\<forall>u::Set. (u\<in>z \<longleftrightarrow> (\<exists>v::Set. u\<in>v \<and> v\<in>{x,y}))" by blast
    then have "\<forall>u::Set. (u\<in>z \<longleftrightarrow> u\<in>\<Union>({x,y}))" using sum_class_lemma by blast
    then have "z=\<Union>({x,y})" by (simp add: set_extensionality)
    then have "set(\<Union>{x,y})" by (metis Ex4_9_b set_predicate_def)
    then show "set(x\<union>y)" using Ex4_13_a by auto
  qed
qed

lemma Ex4_13_c: "\<forall>x::Set. (\<Union>{x} = x)"
by (simp add: Ex4_10_h Ex4_13_a)

lemma Ex4_13_d: "\<forall>x::Set. \<forall>y::Set. (\<Union>\<langle>x,y\<rangle> = {x, y})"
proof
  fix x::Set
  show "\<forall>y::Set. (\<Union>\<langle>x,y\<rangle> = {x, y})"
  proof
    fix y::Set
    show "\<Union>\<langle>x,y\<rangle> = {x, y}"
    proof (rule equalityI)
      show "\<Union>\<langle>x,y\<rangle> \<subseteq> {x, y}"
      proof (rule subsetI)
        fix xa::Set
        assume "xa \<in> \<Union>\<langle>x,y\<rangle>"
        then show "xa \<in> {x, y}" using ordered_pair_def pairing sum_class_lemma by auto
      qed

      show "{x, y} \<subseteq> \<Union>\<langle>x,y\<rangle>"
      proof (rule subsetI)
        fix xa
        assume "xa \<in> {x, y}"
        then show "xa \<in> \<Union>\<langle>x,y\<rangle>" by (metis ordered_pair_def pairing sum_class_lemma)
      qed
    qed
  qed
qed

(* Here goes Exercise 4.14 *)

axiomatization
where power_set:
  "\<forall>x::Set. \<exists>y::Set. \<forall>u::Set. (u\<in>y \<longleftrightarrow> u\<subseteq>x)"

(* The remark right after Axiom W: *)
lemma power_set_lemma: "\<forall>x::Set. (\<P>(x) is a set)"
proof
  fix x::Set
  show "set(\<P>(x))"
  proof -
    have "\<exists>y::Set. \<forall>u::Set. (u\<in>y \<longleftrightarrow> u\<subseteq>x)" using power_set by blast
    then obtain y::Set where *: "\<forall>u::Set. (u\<in>y \<longleftrightarrow> u\<subseteq>x)" by blast
    have "\<forall>u::Set. (u \<in> \<P>(x)) \<longleftrightarrow> (u \<subseteq> x)" by (simp add: power_class_lemma)
    then have "\<forall>u::Set. u\<in>\<P>(x) \<longleftrightarrow> u\<in>y" using * by simp
    then have "\<P>(x) = y" by (simp add: set_extensionality)
    then show "set(\<P>(x))" using Ex4_9_b universe by auto
  qed
qed

axiomatization  (* comprehension axiom if we use a definable class Y *)
where subsets:
  "\<forall>x::Set. \<forall>Y. \<exists>z::Set. \<forall>u::Set. (u\<in>z \<longleftrightarrow> u\<in>x \<and> u\<in>Y)"
-- "combined with the class existence theorem, this is the axiom (not axiom schema) of
    comprehension."

(* page 237 *)

text{* \textbf{FOMUS workshop exercise:} *}

lemma Cor4_6_a: "\<forall>x::Set. \<forall>Y. (x\<inter>Y is a set)"
  -- "The intersection of a set and a class is a set."
sorry

text{* \textbf{FOMUS workshop exercise:} *}

lemma Cor4_6_b: "\<forall>x::Set. \<forall>Y. (Y\<subseteq>x \<longrightarrow> set(Y))"
  -- "A subclass of a set is a set."
sorry

(*  Here goes Cor4_6_c. *)

lemma Ex4_15_a: "\<forall>x::Set. (set(dom x) \<and> set(ran x))"

proof (rule allI, rule conjI)
  fix x::Set
  have *: "dom(x) \<subseteq> \<Union>(\<Union>x)"
  proof (rule subsetI)
    fix y::Set
    assume "y \<in> dom(x)"
    hence "\<exists>z. (\<langle>y,z\<rangle> \<in> x)" by (simp add: B4)
    thus "y\<in>\<Union>(\<Union>x)" by (metis ordered_pair_def pairing sum_class_lemma)
  qed
  have "(\<Union>x) is a set" using sum_set_remark by auto
  thus "(dom(x)) is a set" using *
    by (metis Abs_Set_inverse Cor4_6_b mem_Collect_eq sum_set_remark universe)
next -- "similar proof"
  fix x::Set
  have *: "ran(x) \<subseteq> \<Union>(\<Union>x)"
  proof (rule subsetI)
    fix y::Set
    assume "y \<in> ran(x)"
    hence "\<exists>z. (\<langle>z,y\<rangle> \<in> x)" by (simp add: range_lemma)
    thus "y \<in> \<Union>(\<Union>x)" by (metis ordered_pair_def pairing sum_class_lemma)
  qed
  thus "(ran(x)) is a set" using *
    by (metis Abs_Set_inverse Cor4_6_b mem_Collect_eq sum_set_remark universe)
qed

lemma Ex4_15_b: "\<forall>x::Set. \<forall>y::Set. set(x \<times> y)"
proof
  fix x::Set
  show "\<forall>y::Set. set(x \<times> y)"
  proof
    fix y::Set
    have #: "(x \<times> y) \<subseteq> \<P>(\<P>(x \<union> y))" using Ex4_12_s by simp
    have *: "set(x\<union>y)" by (simp add: Ex4_13_b)
    then have "set(\<P>(x \<union> y))" using power_set_lemma by (metis CollectI Rep_Set_cases universe)
    then have "set(\<P>(\<P>(x \<union> y)))" using power_set_lemma by (metis CollectI Rep_Set_cases universe)
    then show "set(x \<times> y)" using # Cor4_6_b by (metis CollectI Rep_Set_cases universe)
  qed
qed

lemma Ex4_15_c: "set(dom(Y)) \<and> set(ran(Y)) \<and> Rel(Y) \<longrightarrow> set(Y)"
proof
  assume *: "set(dom(Y)) \<and> set(ran(Y)) \<and> Rel(Y)"
  then have 1: "Y\<subseteq>(dom Y)\<times>(ran Y)" and #: "set(dom(Y))" and ##: "set(ran(Y))"
    using Ex4_12_t by (simp,simp,simp)
  then have "set((dom Y)\<times>(ran Y))" using Ex4_15_b # ## by (metis CollectI Rep_Set_cases universe)
  from 1 and this show "set(Y)" using Cor4_6_b by (metis CollectI Rep_Set_cases universe)
qed

lemma Ex4_15_d: "Pr(Y) \<and> Y\<subseteq>X \<longrightarrow> Pr(X)"
proof
  assume "Pr(Y) \<and> Y\<subseteq>X"
  then have 1: "Pr(Y)" and 2: "Y\<subseteq>X" by (rule conjunct1, rule conjunct2)
  show "Pr(X)"
  proof (rule ccontr)
    assume "~Pr(X)"
    then have "set(X)" by (simp add: proper_class_predicate_def)
    then have "set(Y)" using 2 Cor4_6_b by (metis CollectI Rep_Set_cases universe)
    then show "False" using 1 by (simp add: proper_class_predicate_def)
  qed
qed

lemma int_class_definable[defining]: "definable(\<lambda>x::Set. (\<forall>v::Set. v\<in>X \<longrightarrow> x\<in>v))"
unfolding definable_def
proof
  let ?f = "\<lambda>x::Set. (\<forall>v::Set. v\<in>X \<longrightarrow> x\<in>v)"
  def \<phi> \<equiv> "(FAll 10 (FImp (FBelongs (FVar 10) (FConst X))
                           (FBelongs (FVar 0) (FVar 10))))"
  show "\<forall>i. (FOL_True \<phi> i \<longleftrightarrow> ?f(i(0)))"
     unfolding \<phi>_def using "FOL_True.simps" "FOL_Eval.simps" Update_def by auto
qed

definition
  int_class :: "Class \<Rightarrow> Class" ("\<Inter>")
  where "\<Inter>X = { x::Set \<bar> (\<forall>v::Set. v\<in>X \<longrightarrow> x\<in>v)}"

lemma int_class_lemma: "\<forall>x::Set. x \<in> \<Inter>X \<longleftrightarrow> (\<forall>v::Set. v\<in>X \<longrightarrow> x\<in>v)"
by (simp add: class_comprehension_property int_class_def int_class_definable)

text{* \textbf{FOMUS workshop exercise:} **  *}

lemma Prop4_7_a: "\<forall>x::Set. x\<in>X \<longrightarrow> (\<Inter>X \<subseteq> x)"
sorry

lemma Prop4_7_b: "X \<noteq> \<emptyset> \<longrightarrow> set(\<Inter>X)"
proof
  assume "X\<noteq>\<emptyset>"
  then obtain x::Set where "x\<in>X" using empty_set Rep_Set_inject set_extensionality by blast
  then have "\<Inter>X\<subseteq>x" using Prop4_7_a by simp
  then show "set(\<Inter>X)" using Cor4_6_b by simp
qed

lemma Prop4_7_c: "\<Inter>\<emptyset> = \<V>"
proof (rule equalityI)
  show "\<Inter>\<emptyset> \<subseteq> \<V>"
  proof (rule subsetI)
    fix x::Set
    assume "x\<in>\<Inter>\<emptyset>"
    show "x\<in>\<V>" using Ex4_9_b by auto
  qed

  show "\<V> \<subseteq> \<Inter>\<emptyset>"
  proof (rule subsetI)
    fix x::Set
    assume "x\<in>\<V>"
    show "x\<in>\<Inter>\<emptyset>" by (simp add: empty_set int_class_lemma)
  qed
qed

(*  page 238 *)

lemma Ex4_16_a: "\<Inter>{x, y} = x\<inter>y"
proof (rule equalityI)
  show "\<Inter>{x, y} \<subseteq> x\<inter>y"
  proof (rule subsetI)
    fix xa::Set
    assume "xa\<in>\<Inter>{x, y}"
    show "xa \<in> x\<inter>y" using B2 \<open>Rep_Set xa \<in> \<Inter> (Rep_Set {x, y})\<close> int_class_lemma pairing by auto
  qed

  show "x\<inter>y \<subseteq> \<Inter>{x, y}"
  proof (rule subsetI)
    fix xa::Set
    assume "xa\<in>x\<inter>y"
    show "xa\<in>\<Inter>{x, y}" using B2 \<open>Rep_Set xa \<in> Rep_Set x \<inter> Rep_Set y\<close> int_class_lemma pairing by auto
  qed
qed

lemma Ex4_16_b: "\<Inter>{x} = x"
by (simp add: Ex4_10_g Ex4_16_a)

lemma Ex4_16_c: "X\<subseteq>Y \<longrightarrow> \<Inter>Y \<subseteq> \<Inter>X"
proof
  assume "X\<subseteq>Y"
  show "\<Inter>Y \<subseteq> \<Inter>X"
  proof (rule subsetI)
    fix x::Set
    assume "x\<in>\<Inter>Y"
    show "x\<in>\<Inter>X" using \<open>Rep_Set x \<in> \<Inter> Y\<close> \<open>X \<subseteq> Y\<close> int_class_lemma subset by blast
  qed
qed

definition Fnc :: "Class \<Rightarrow> bool" ("(_ is a function)" [71] 70)
  where "Fnc(X) == Rel(X) \<and> (\<forall>x y z::Set. (\<langle>x,y\<rangle>\<in>X \<and> \<langle>x,z\<rangle>\<in>X) \<longrightarrow> y=z)"

definition function_from_to :: "Class \<Rightarrow> Class \<Rightarrow> Class \<Rightarrow> bool"
  ("(_ is a function from _ to _)" 70)
  where "X is a function from Y to Z == Fnc(X) \<and> (dom(X) = Y) \<and> (ran(X) \<subseteq> Z)"
notation function_from_to ("(_: _ \<rightarrow> _)"  70)

definition
  restriction :: "Class \<Rightarrow> Class \<Rightarrow> Class"  (infixl "\<restriction>" 80)
  where "(X\<restriction>Y) \<equiv> X\<inter>(Y\<times>\<V>)"
--"Warning, Mendelson defines this X\<down>Y, with a curly arrow and the X and Y switched. We use the
   modern ."

definition Fnc1 :: "Class \<Rightarrow> bool" ("(_ is a 1-1 function)")
  where "Fnc1(X) == Fnc(X) \<and> Fnc(Inv(X))"
notation   Fnc1 ("(_ is an injection)" 70)

(* "onto" is defined in Mendelson's book introduction. I add this here as it fits
           after the injection, and I also add bijection. *)

definition surjection_from_onto :: "Class \<Rightarrow> Class \<Rightarrow> Class \<Rightarrow> bool"
  ("(_ is a surjection from _ onto _)")
  where "(F is a surjection from A onto B) \<longleftrightarrow> (F:A\<rightarrow>B) \<and> (ran(F) = B)"

definition bijection_from_to :: "Class \<Rightarrow> Class \<Rightarrow> Class \<Rightarrow> bool"
  ("(_) is a bijection from (_) to (_)")
  where "(F is a bijection from A to B) \<longleftrightarrow> (F:A\<rightarrow>B) \<and> (F is an injection) \<and> (ran(F) = B)"

(* The following definition might be buggy*)

(* The following used to be called image, when in fact it is the value_of the
           function X at Y. The definition below this one is the one of image. *)
definition
  value_of :: "Class \<Rightarrow> Class \<Rightarrow> Set"  (infixl "\<acute>" 80)
  where "X\<acute>Y == (if   (\<exists>!u::Set. (\<langle>Abs_Set Y, u\<rangle> \<in> X))
                 then THE u::Set. (\<langle>Abs_Set Y, u\<rangle> \<in> X)
                 else \<emptyset>)"

lemma value_of_lemma:
  fixes X::Class
  fixes y::Set
  assumes "X is a function"
  and "y\<in>dom(X)"
  shows "\<exists>z::Set. \<langle>y,z\<rangle>\<in>X"
using B4 assms(2) by auto

abbreviation set_value_of :: "Set \<Rightarrow> Set \<Rightarrow> Set"
(* Since we can't overload the \acute symbol, is there any benefit on keeping this
           definition? *)
  where "set_value_of x y \<equiv> value_of x y"

definition
  image :: "Class \<Rightarrow> Class \<Rightarrow> Class"  (infixl "\<hungarumlaut>" 80) --"This symbol is called hungarumlaut."
where "(X\<hungarumlaut>Y) \<equiv> ran(X\<restriction>Y)"

lemma Ex4_17_a: "Fnc(X) \<and> (y::Set)\<in>dom(X) \<longrightarrow> (\<forall>z::Set. (X\<acute>y) = z \<longleftrightarrow> \<langle>y,z\<rangle>\<in>X)"
proof (rule impI)
  assume *: "X is a function \<and> Rep_Set y \<in> dom X"
  have **:  "\<forall> b c d::Set. (\<langle>d,b\<rangle>\<in>X \<and> \<langle>d,c\<rangle>\<in>X) \<longrightarrow> b=c" using * by (simp add: Fnc_def)
  hence ***: "\<forall>b c::Set. (\<langle>y,b\<rangle>\<in>X \<and> \<langle>y,c\<rangle>\<in>X) \<longrightarrow> b=c" by auto
  obtain u::Set where u: "\<langle>y,u\<rangle>\<in>X" using value_of_lemma * by auto
  hence u': "\<forall>b::Set. (\<langle>y,b\<rangle>\<in>X \<and> \<langle>y,u\<rangle>\<in>X) \<longrightarrow> b=u" using ** by auto
  hence ****: "\<exists>!u. (\<langle>y,u\<rangle>\<in>X)" using u by blast
  show "\<forall>z::Set. (X\<acute>y) = z \<longleftrightarrow> \<langle>y,z\<rangle>\<in>X"
  proof (rule allI, rule iffI)
    fix z::Set
    assume "(X\<acute>y) = z"
    hence "z = (X\<acute>y)" .. --"Strangely, the proof below fails without this step."
    hence "z = (if (\<exists>!u::Set. (\<langle>y, u\<rangle> \<in> X))
                          then THE u::Set. (\<langle>y, u\<rangle> \<in> X)
                          else \<emptyset>)"  unfolding value_of_def using * by (simp add: Rep_Set_inverse)
    hence "z = (THE u::Set. (\<langle>y, u\<rangle> \<in> X))" using **** by auto
    hence "\<langle>y,z\<rangle>\<in>X" using the1I2 **** Rep_Set_inverse by metis
    thus "X \<acute> Rep_Set y = z \<Longrightarrow> Rep_Set \<langle>y, z\<rangle> \<in> X" by auto
  next
    fix z::Set
    assume "\<langle>y,z\<rangle>\<in>X"
    hence "(THE u::Set. (\<langle>y, u\<rangle> \<in> X)) = z" using Rep_Set_inverse by (metis u' u the_equality)
    thus "X\<acute>y = z" unfolding value_of_def using Abs_Set_inverse Rep_Set_inverse **** the_equality
      by auto
  qed
qed

lemma Ex4_17_b: "X is a function \<and> Y \<subseteq> dom(X) \<longrightarrow>
                 ((X\<restriction>Y) is a function \<and> (dom(X\<restriction>Y) = Y) \<and> (\<forall>y::Set. y\<in>Y \<longrightarrow> X\<acute>y = (X\<restriction>Y)\<acute>y))"
proof
  assume *: "X is a function \<and> Y \<subseteq> dom(X)"
  show "(X\<restriction>Y) is a function \<and> (dom(X\<restriction>Y) = Y) \<and> (\<forall>y::Set. y\<in>Y \<longrightarrow> (X\<acute>y = (X\<restriction>Y)\<acute>y))"
  proof
    show 1: "(X\<restriction>Y) is a function"
    proof (unfold Fnc_def)
      show "(X \<restriction> Y) is a relation \<and> (\<forall>x y z::Set. \<langle>x,y\<rangle>\<in>(X\<restriction>Y) \<and> \<langle>x,z\<rangle>\<in>(X\<restriction>Y) \<longrightarrow> y=z)"
      proof
        show "(X \<restriction> Y) is a relation" using * by (metis Ex4_10_c Ex4_10_e Ex4_10_k Ex4_12_h
          relation_predicate_def restriction_def square)
        show "\<forall>x y z::Set. \<langle>x,y\<rangle>\<in>(X\<restriction>Y) \<and> \<langle>x,z\<rangle>\<in>(X\<restriction>Y) \<longrightarrow> y=z"
          using * by (metis Fnc_def notin_inter_mono restriction_def)
      qed
    qed
    show "(dom(X\<restriction>Y) = Y) \<and> (\<forall>y::Set. y\<in>Y \<longrightarrow> (X\<acute>y = (X\<restriction>Y)\<acute>y))"
    proof
      show 2: "dom(X\<restriction>Y) = Y"
      proof (unfold set_extensionality)
        show "\<forall>x::Set. x\<in>dom(X\<restriction>Y) \<longleftrightarrow> x\<in>Y"
        proof
          fix x::Set
          have "x\<in>dom(X\<restriction>Y) \<longleftrightarrow> (\<exists>v::Set. (\<langle>x, v\<rangle>\<in>X\<inter>(Y\<times>\<V>)))" by (simp add: B4 restriction_def)
          then have "x\<in>dom(X\<restriction>Y) \<longleftrightarrow> (\<exists>v::Set. (\<langle>x, v\<rangle>\<in>X \<and> \<langle>x, v\<rangle>\<in>(Y\<times>\<V>)))" using B2 by auto
          then have #: "x\<in>dom(X\<restriction>Y) \<longleftrightarrow> (\<exists>v::Set. (\<langle>x, v\<rangle>\<in>X \<and> \<langle>x, v\<rangle>\<in>(Y\<times>\<V>) \<and> x\<in>Y))"
            by (metis Prop4_3 Rep_Set_inject cartesian_product_lemma)
          from * have "\<forall>x2::Set. (x2\<in>Y \<longleftrightarrow> (\<exists>w::Set. \<langle>x2,w\<rangle>\<in>X) \<and> x2\<in>Y)"
            using B4 subclass'_def by blast
          then show "x\<in>dom(X\<restriction>Y) \<longleftrightarrow> x\<in>Y" using # Ex4_9_b cartesian_product_lemma by blast
        qed
      qed
      show "\<forall>y::Set. y\<in>Y \<longrightarrow> (X\<acute>y = (X\<restriction>Y)\<acute>y)"
        using * 1 2 by (metis B4 Ex4_17_a notin_inter_mono restriction_def)
    qed
  qed
qed

lemma Ex4_17_c: "Fnc(X) \<longrightarrow>
                (Fnc1(X) \<longleftrightarrow> (\<forall>y z::Set. (y\<in>dom(X) \<and> z\<in>dom(X) \<and> y\<noteq>z) \<longrightarrow> (X\<acute>y \<noteq> X\<acute>z)))"
proof (rule impI)
  fix X::Class
  assume "Fnc(X)"
  from \<open>Fnc(X)\<close> have *: "Fnc1(X) \<longleftrightarrow> Fnc(Inv(X))" by (simp add: Fnc1_def)
  from \<open>Fnc(X)\<close> have **: "Rel(Inv(X))" by (metis Ex4_10_c Ex4_12_o Fnc_def relation_predicate_def)
  show "Fnc1(X) \<longleftrightarrow> (\<forall>y z::Set. ((y\<in>dom(X) \<and> z\<in>dom(X) \<and> y\<noteq>z) \<longrightarrow> X\<acute>y \<noteq> X\<acute>z))"
  proof (rule iffI, rule allI, rule allI, rule impI)
    assume "Fnc1(X)"
    fix y z::Set
    assume 0: "y\<in>dom(X) \<and> z\<in>dom(X) \<and> y\<noteq>z"
    show "X\<acute>y \<noteq> X\<acute>z"
    proof (rule ccontr)
      assume "\<not>(X\<acute>y \<noteq> X\<acute>z)"
      hence 1: "X\<acute>y = X\<acute>z" by simp
      then obtain u::Set where 2: "\<langle>u,X\<acute>y\<rangle>\<in>X" and 3: "\<langle>u,X\<acute>z\<rangle>\<in>X"
        unfolding Fnc1_def Fnc_def by (metis "0" Ex4_17_a \<open>X is a function\<close>)
      hence "y=z" by (metis "*" "0" B4 Ex4_17_a Fnc_def
                                \<open>X is a function\<close> \<open>X is an injection\<close> inverse_relation_lemma)
      thus False using 0 by simp
    qed
    next
    assume 0: "\<forall>y z::Set. ((y\<in>dom(X) \<and> z\<in>dom(X) \<and> y\<noteq>z) \<longrightarrow> X\<acute>y \<noteq> X\<acute>z)"
    have "\<forall>x y z::Set. (\<langle>x,y\<rangle>\<in>(Inv(X)) \<and> \<langle>x,z\<rangle>\<in>(Inv(X))) \<longrightarrow> (y=z)"
    proof (rule allI, rule allI, rule allI, rule impI)
      fix x y z::Set
      assume 1: "\<langle>x,y\<rangle>\<in>Inv(X) \<and> \<langle>x,z\<rangle>\<in>Inv(X)"
      hence "\<langle>y,x\<rangle>\<in>X \<and> \<langle>z,x\<rangle>\<in>X" using inverse_relation_lemma by simp
      thus "y=z" by (metis "0" B4 Ex4_17_a Fnc_def \<open>Fnc(X)\<close>)
    qed
    thus "X is an injection" by (simp add: "*" "**" Fnc_def)
  qed
qed

lemma Ex4_17_d: "Fnc(X) \<and> Y\<subseteq>dom(X) \<longrightarrow> (\<forall>z::Set. z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>y::Set. y\<in>Y \<and> X\<acute>y = z))"
proof
  assume *: "Fnc(X) \<and> Y\<subseteq>dom(X)"
  show "\<forall>z::Set. z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>y::Set. y\<in>Y \<and> X\<acute>y = z)"
  proof
    fix z::Set
    have "z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>v::Set. \<langle>v,z\<rangle>\<in>X \<and> \<langle>v,z\<rangle>\<in>(Y\<times>\<V>))"
      by (simp add: image_def range_lemma restriction_def B2)
    then have "z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>v::Set.\<langle>v,z\<rangle>\<in>X \<and> v\<in>Y)"
      using Ex4_9_b by (metis Prop4_3 Rep_Set_inject cartesian_product_lemma)
    then have "z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>v::Set. X\<acute>v = z \<and> v\<in>Y)" using * Ex4_17_a subclass'_def by blast
    then show "z\<in>X\<hungarumlaut>Y \<longleftrightarrow> (\<exists>y::Set. y\<in>Y \<and> X\<acute>y = z)" by blast
  qed
qed

(* page 239 *)

text{* \subsection*{Axiom R - Replacement} *}

axiomatization
where replacement:
  "Fnc(Y) \<longrightarrow> (\<forall>x::Set. \<exists>y::Set. \<forall>u::Set. (u\<in>y \<longleftrightarrow> (\<exists>v::Set. \<langle>v,u\<rangle>\<in>Y \<and> v\<in>x)))"

text{*
      \begin{quote}
      Axiom R asserts that, if $Y$ is a function and $x$ is a set, then the class of second
      components of ordered pairs in $Y$ whose first components are in $x$ is a set
      (or, equivalently, $ran(x\upharpoonright Y)$ is a set).
      \end{quote}
*}

lemma replacement_remark:
  assumes "Y is a function"
  fixes x::Set
  shows "(ran(Y\<restriction>x)) is a set"
 --"This is obvious for Mendelson, not for Isabelle, and Sledgehammer cannot find a proof."
proof -
  have "(\<exists>y::Set. \<forall>u::Set. (u\<in>y \<longleftrightarrow> (\<exists>v::Set. \<langle>v,u\<rangle>\<in>Y \<and> v\<in>x)))" using replacement assms by auto
  then obtain y :: Set where "\<forall>u::Set. (u\<in>y \<longleftrightarrow> (\<exists>v::Set. \<langle>v,u\<rangle>\<in>Y \<and> v\<in>x))" by auto
  hence "\<forall>u::Set. (u\<in>y \<longleftrightarrow> (\<exists>v::Set. \<langle>v,u\<rangle>\<in>(Y\<restriction>x)))" using restriction_def
    by (metis B2 B5 Rep_Set cartesian_product_lemma mem_Collect_eq)
  hence "\<forall>u::Set. (u\<in>y \<longleftrightarrow> (u\<in>ran(Y\<restriction>x)))" using range_lemma[where Y="(Y\<restriction>x)"] by simp
  hence "y=ran(Y\<restriction>x)" using set_extensionality by simp
  thus ?thesis by (metis Ex4_9_b universe)
qed

(* Exercise 4.18 would require our theory to be build using locales. *)

(*
  lemma Ex4_18: Show that,  in  the presence  of  the other axioms, the replacement axiom
  (R) implies the axiom  of  subsets (S).
*)

text{* \textbf{FOMUS workshop exercise:} *}

lemma Ex4_19: "Fnc(Y) \<longrightarrow> (\<forall>x::Set. (Y\<hungarumlaut>x is a set))"
sorry

(* Exercises 4.20 and 4.21 require our theories to be build using locales. *)

(*
  lemma Ex4_20: the Show  that  axiom R is equivalent  to  the  wf
  "Fnc(Y) \<and> set(dom(Y)) \<longrightarrow> set(ran(Y))"

  lemma Ex4_21: Show that,  in  the presence  of  all axioms except  RandS,  axiom R is
  equivalent to the conjunction  of  axiom S  and  the  wf
 "Fnc1(Y) \<and> set(dom(Y)) \<longrightarrow> set(ran(Y))"
*)

text{* \subsection*{Axiom I (Axiom of Infinity)} *}

axiomatization
where infinity:
  "\<exists>x::Set. (\<emptyset>\<in>x \<and> (\<forall>u::Set. (u\<in>x \<longrightarrow> (u\<union>{u})\<in>x)))"

text{* \begin{quote}
       Axiom I states that there is a set $x$ that contains 0 and such that, whenever a
       set $u$ belongs to $x$, then $u \cup \{u\}$ also belongs to $x$. Hence, for such a set $x$,
       $\{0\} \in x$, $\{0, \{0\}\}\in x$, $\{0, \{0\}, \{0, \{0\}\}\}\in x$, and so on.
       If we let 1 stand for $\{0\}$, 2 for $\{0, 1\}$, 3 for $\{0, 1, 2\}$, ... , $n$ for
       $\{0, 1, 2, ... , n - 1\}$, etc., then, for all ordinary integers $n > 0$, $n\in x$,
       and $0 -/=- 1, 0 -/=- 2, 1 -/=- 2, 0 -1 3, 1 f:- 3, 2 #-3, ...
       \end{quote} *}

primrec set_integer :: "nat \<Rightarrow> Set" ("int")
  where "int(0)     = Abs_Set \<emptyset>"
      | "int(Suc n) = Abs_Set (int(n)\<union>{int(n)})"

text{* \textbf{FOMUS workshop extra exercise:} *}

lemma infinity_remark:
  "\<forall>n::nat. int(n)\<noteq>int(Suc n)"
  and "\<exists>x::Set. \<forall>n::nat. int(n)\<in>x"
sorry

(*
  lemma Ex_4_22_a: Prove  that  any  wf  that  implies "\<exists>X. set(X)" would, together with
  axiom  S,  imply axiom N.
*)

(*
  lemma Ex_4_22_b: Show that axiom I is equivalent  to  the following sentence  (I* ):
  "\<exists>x. ((\<exists>y. y\<in>x \<and> (\<forall>u. u\<notin>y)) \<and> (\<forall>u. u\<in>x \<longrightarrow> (u\<union>{u})\<in>x) )"
*)

(* page 240 *)

text{* \begin{quote}
       This completes the List of axioms of NBG, and we see that NBG has only a
       finite number of axioms - namely, axiom T, axiom P (pairing), axiom N
       (null set), axion1 U (sum set), axiom W (power set), axiomS (subsets), axiom
       R (replacement), axiom 1 (infinity), and the seven class existence axioms
       (Bl)-(B7). We have also seen that axiom S is provable from the other
       axioms; it has been included here because it is of interest in the study of
       certain weaker subtheories of NBG.  Let us verify now that the usual argument
       for Russell's paradox does not hold in NBG.
       \end{quote} *}

text{* \textbf{FOMUS workshop exercise:} *}

lemma no_Russells_paradox:
    fixes Y :: Class
  assumes "Y = { x \<bar> x\<notin>x }"
    shows "Y is not a set"
proof (rule ccontr)
  have "definable(\<lambda>x. x\<notin>x)"
  sorry
  then have *: "\<forall>x::Set. x\<in>Y \<longleftrightarrow> x\<notin>x" by (simp add: assms class_comprehension_property)
  assume "\<not>\<not>(Y is a set)"
  then have "Y\<in>Y \<longleftrightarrow> Y\<notin>Y" by (metis DomainpE Set.domain_eq Set.pcr_cr_eq * cr_Set_def universe)
  hence "Y\<in>Y \<and> Y\<notin>Y" by simp
  thus False by simp
qed

text{* Thus, in NBG, the argument for Russell's paradox merely shows that Russell's
       class Y is a proper class, not a set. NBG will avoid the paradoxes of Cantor and
       Burali-Forti in a similar way.*}

text{* \textbf{FOMUS workshop extra exercise:} *}

lemma Ex4_23: "\<not>set(\<V>)"
sorry

end