# Theory Pointed_DC_Relative

```section‹Relative DC›

theory Pointed_DC_Relative
imports
Cardinal_Library_Relative

begin

consts dc_witness :: "i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ i"
primrec
wit0   : "dc_witness(0,A,a,s,R) = a"
witrec : "dc_witness(succ(n),A,a,s,R) = s`{x∈A. ⟨dc_witness(n,A,a,s,R),x⟩∈R}"

lemmas dc_witness_def = dc_witness_nat_def

relativize functional "dc_witness" "dc_witness_rel"
relationalize "dc_witness_rel" "is_dc_witness"
(* definition
is_dc_witness_fm where
"is_dc_witness_fm(na, A, a, s, R, e) ≡ is_transrec_fm
(is_nat_case_fm
(a +⇩ω 8, (⋅∃⋅⋅4`2 is 0⋅ ∧ (⋅∃⋅⋅s +⇩ω 12`0 is 2⋅ ∧ Collect_fm(A +⇩ω 12, ⋅(⋅∃⋅0 = 0⋅⋅) ∧ (⋅∃⋅⋅0 ∈ R +⇩ω 14⋅ ∧ pair_fm(3, 1, 0) ⋅⋅)⋅, 0) ⋅⋅)⋅⋅), 2,
0), na, e)"
*)
schematic_goal sats_is_dc_witness_fm_auto:
assumes "na < length(env)" "e < length(env)"
shows
"   na ∈ ω ⟹
A ∈ ω ⟹
a ∈ ω ⟹
s ∈ ω ⟹
R ∈ ω ⟹
e ∈ ω ⟹
env ∈ list(Aa) ⟹
0 ∈ Aa ⟹
is_dc_witness(##Aa, nth(na, env), nth(A, env), nth(a, env), nth(s, env), nth(R, env), nth(e, env)) ⟷
Aa, env ⊨ ?fm(nat, A, a, s, R, e)"
unfolding is_dc_witness_def is_recursor_def
by (rule is_transrec_iff_sats | simp_all)
(rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp add:assms)+

synthesize "is_dc_witness" from_schematic

manual_arity for "is_dc_witness_fm"
unfolding is_dc_witness_fm_def apply (subst arity_transrec_fm)
apply (subst arity_is_nat_case_fm)
apply (simp add:arity del:arity_transrec_fm) prefer 5

definition dcwit_body :: "[i,i,i,i,i] ⇒ o" where
"dcwit_body(A,a,g,R) ≡ λp. snd(p) = dc_witness(fst(p), A, a, g, R)"

relativize functional "dcwit_body" "dcwit_body_rel"
relationalize "dcwit_body_rel" "is_dcwit_body"

synthesize "is_dcwit_body" from_definition assuming "nonempty"
arity_theorem for "is_dcwit_body_fm"

context M_replacement
begin

lemma dc_witness_closed[intro,simp]:
assumes "M(n)" "M(A)" "M(a)" "M(s)" "M(R)" "n∈nat"
shows "M(dc_witness(n,A,a,s,R))"
using ‹n∈nat›
proof(induct)
case 0
with ‹M(a)›
show ?case
unfolding dc_witness_def by simp
next
case (succ x)
with assms
have "M(dc_witness(x,A,a,s,R))" (is "M(?b)")
by simp
moreover from this assms
have "M(({?b}×A)∩R)" (is "M(?X)") by auto
moreover
have "{x∈A. ⟨?b,x⟩∈R} = {snd(y) . y∈?X}" (is "_ = ?Y")
by(intro equalityI subsetI,force,auto)
moreover from calculation
have "M(?Y)"
using lam_replacement_snd lam_replacement_imp_strong_replacement RepFun_closed
snd_closed[OF transM]
by auto
ultimately
show ?case
using ‹M(s)› apply_closed
unfolding dc_witness_def by simp
qed

lemma dc_witness_rel_char:
assumes "M(A)"
shows "dc_witness_rel(M,n,A,a,s,R) = dc_witness(n,A,a,s,R)"
proof -
from assms
have "{x ∈ A . ⟨rec, x⟩ ∈ R} =  {x ∈ A . M(x) ∧ ⟨rec, x⟩ ∈ R}" for rec
by (auto dest:transM)
then
show ?thesis
unfolding dc_witness_def dc_witness_rel_def by simp
qed

lemma (in M_basic) first_section_closed:
assumes
"M(A)" "M(a)" "M(R)"
shows "M({x ∈ A . ⟨a, x⟩ ∈ R})"
proof -
have "{x ∈ A . ⟨a, x⟩ ∈ R} = range({a} × range(R) ∩ R) ∩ A"
by (intro equalityI) auto
with assms
show ?thesis
by simp
qed

lemma witness_into_A [TC]:
assumes "a∈A"
"∀X[M]. X≠0 ∧ X⊆A ⟶ s`X∈A"
"∀y∈A. {x∈A. ⟨y,x⟩∈R } ≠ 0" "n∈nat"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "dc_witness(n, A, a, s, R)∈A"
using ‹n∈nat›
proof(induct n)
case 0
then show ?case using ‹a∈A› by simp
next
case (succ x)
with succ assms(1,3-)
show ?case
using nat_into_M first_section_closed
by (simp, rule_tac rev_subsetD, rule_tac assms(2)[rule_format])
auto
qed

end ― ‹\<^locale>‹M_replacement››

locale M_DC = M_trancl + M_replacement + M_eclose +
assumes
separation_is_dcwit_body:
"M(A) ⟹ M(a) ⟹ M(g) ⟹ M(R) ⟹ separation(M,is_dcwit_body(M, A, a, g, R))"
and
dcwit_replacement:"Ord(na) ⟹
M(na) ⟹
M(A) ⟹
M(a) ⟹
M(s) ⟹
M(R) ⟹
transrec_replacement
(M, λn f ntc.
is_nat_case
(M, a,
λm bmfm.
∃fm[M]. ∃cp[M].
is_apply(M, f, m, fm) ∧
is_Collect(M, A, λx. ∃fmx[M]. (M(x) ∧ fmx ∈ R) ∧ pair(M, fm, x, fmx), cp) ∧
is_apply(M, s, cp, bmfm),
n, ntc),na)"
begin

lemma is_dc_witness_iff:
assumes "Ord(na)" "M(na)" "M(A)" "M(a)" "M(s)" "M(R)" "M(res)"
shows "is_dc_witness(M, na, A, a, s, R, res) ⟷ res = dc_witness_rel(M, na, A, a, s, R)"
proof -
note assms
moreover from this
have "{x ∈ A . M(x) ∧ ⟨f, x⟩ ∈ R} = {x ∈ A . ⟨f, x⟩ ∈ R}" for f
by (auto dest:transM)
moreover from calculation
have "M(fm) ⟹ M({x ∈ A . M(x) ∧ ⟨fm, x⟩ ∈ R})" for fm
using first_section_closed by (auto dest:transM)
moreover from calculation
have "M(x) ⟹ M(z) ⟹ M(mesa) ⟹
(∃ya[M]. pair(M, x, ya, z) ∧
is_wfrec(M, λn f. is_nat_case(M, a, λm bmfm. ∃fm[M]. is_apply(M, f, m, fm) ∧
is_apply(M, s, {x ∈ A . ⟨fm, x⟩ ∈ R}, bmfm), n), mesa, x, ya))
⟷
(∃y[M]. pair(M, x, y, z) ∧
is_wfrec(M, λn f. is_nat_case(M, a,
λm bmfm.
∃fm[M]. ∃cp[M]. is_apply(M, f, m, fm) ∧
is_Collect(M, A, λx. M(x) ∧ ⟨fm, x⟩ ∈ R, cp) ∧  is_apply(M, s, cp, bmfm),n),
mesa, x, y))" for x z mesa by simp
moreover from calculation
show ?thesis
using assms dcwit_replacement[of na A a s R]
unfolding is_dc_witness_def dc_witness_rel_def
by (rule_tac recursor_abs) (auto dest:transM)
qed

lemma dcwit_body_abs:
"fst(x) ∈ ω ⟹ M(A) ⟹ M(a) ⟹ M(g) ⟹ M(R) ⟹ M(x) ⟹
is_dcwit_body(M,A,a,g,R,x) ⟷ dcwit_body(A,a,g,R,x)"
using pair_in_M_iff apply_closed transM[of _ A]
is_dc_witness_iff[of "fst(x)" "A" "a" "g" "R" "snd(x)"]
fst_snd_closed dc_witness_closed
unfolding dcwit_body_def is_dcwit_body_def
by (auto dest:transM simp:absolut dc_witness_rel_char del:bexI intro!:bexI)

lemma Lambda_dc_witness_closed:
assumes "g ∈ Pow⇗M⇖(A)-{0} → A" "a∈A" "∀y∈A. {x ∈ A . ⟨y, x⟩ ∈ R} ≠ 0"
"M(g)" "M(A)" "M(a)" "M(R)"
shows "M(λn∈nat. dc_witness(n,A,a,g,R))"
proof -
from assms
have "(λn∈nat. dc_witness(n,A,a,g,R)) = {p ∈ ω × A . is_dcwit_body(M,A,a,g,R,p)}"
using witness_into_A[of a A g R]
Pow_rel_char apply_type[of g "{x ∈ Pow(A) . M(x)}-{0}" "λ_.A"]
unfolding lam_def split_def
apply (intro equalityI subsetI)
apply (auto) (* slow *)
by (subst dcwit_body_abs, simp_all add:transM[of _ ω] dcwit_body_def,
subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def)
(* by (intro equalityI subsetI, auto) (* Extremely slow *)
(subst dcwit_body_abs, simp_all add:transM[of _ ω] dcwit_body_def,
subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def) *)
with assms
show ?thesis
using separation_is_dcwit_body dc_witness_rel_char unfolding split_def by simp
qed

lemma witness_related:
assumes "a∈A"
"∀X[M]. X≠0 ∧ X⊆A ⟶ s`X∈X"
"∀y∈A. {x∈A. ⟨y,x⟩∈R } ≠ 0" "n∈nat"
"M(a)" "M(A)" "M(s)" "M(R)" "M(n)"
shows "⟨dc_witness(n, A, a, s, R),dc_witness(succ(n), A, a, s, R)⟩∈R"
proof -
note assms
moreover from this
have "(∀X[M]. X≠0 ∧ X⊆A ⟶ s`X∈A)" by auto
moreover from calculation
have "dc_witness(n, A, a, s, R)∈A" (is "?x ∈ A")
using witness_into_A[of _ _ s R n] by simp
moreover from assms
have "M({x ∈ A . ⟨dc_witness(n, A, a, s, R), x⟩ ∈ R})"
using first_section_closed[of A "dc_witness(n, A, a, s, R)"]
by simp
ultimately
show ?thesis by auto
qed

lemma witness_funtype:
assumes "a∈A"
"∀X[M]. X≠0 ∧ X⊆A ⟶ s`X ∈ A"
"∀y∈A. {x∈A. ⟨y,x⟩∈R} ≠ 0"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "(λn∈nat. dc_witness(n, A, a, s, R)) ∈ nat → A" (is "?f ∈ _ → _")
proof -
have "?f ∈ nat → {dc_witness(n, A, a, s, R). n∈nat}" (is "_ ∈ _ → ?B")
using lam_funtype assms by simp
then
have "?B ⊆ A"
using witness_into_A assms by auto
with ‹?f ∈ _›
show ?thesis
using fun_weaken_type
by simp
qed

lemma witness_to_fun:
assumes "a∈A"
"∀X[M]. X≠0 ∧ X⊆A ⟶ s`X∈A"
"∀y∈A. {x∈A. ⟨y,x⟩∈R } ≠ 0"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "∃f ∈ nat→A. ∀n∈nat. f`n =dc_witness(n,A,a,s,R)"
using assms bexI[of _ "λn∈nat. dc_witness(n,A,a,s,R)"] witness_funtype
by simp

end ― ‹\<^locale>‹M_DC››

locale M_library_DC = M_library + M_DC
begin

lemma AC_M_func:
assumes "⋀x. x ∈ A ⟹ (∃y. y ∈ x)" "M(A)"
shows "∃f ∈ A →⇗M⇖ ⋃(A). ∀x ∈ A. f`x ∈ x"
proof -
from ‹M(A)›
interpret mpiA:M_Pi_assumption_repl _ A "λx . x"
from ‹M(A)›
interpret mpi2:M_Pi_assumption_repl _ "⋃A" "λx . x"
from ‹M(A)›
interpret mpic_A:M_Pi_assumptions_choice _ A "λx. x"
apply unfold_locales
using lam_replacement_constant lam_replacement_identity
lam_replacement_identity[THEN lam_replacement_imp_strong_replacement]
lam_replacement_minimum[THEN [5] lam_replacement_hcomp2]
unfolding lam_replacement_def[symmetric]
by auto
from assms
show ?thesis
using apply_type mpiA.mem_Pi_rel_abs mpi2.mem_Pi_rel_abs function_space_rel_char
by (rule_tac mpic_A.AC_Pi_rel[THEN rexE], simp,rename_tac f,rule_tac x=f in bexI)
(auto, rule_tac C="λx. x" in Pi_type,auto)
qed

lemma non_empty_family: "[| 0 ∉ A;  x ∈ A |] ==> ∃y. y ∈ x"
by (subgoal_tac "x ≠ 0", blast+)

lemma AC_M_func0: "0 ∉ A ⟹ M(A) ⟹ ∃f ∈ A →⇗M⇖ ⋃(A). ∀x ∈ A. f`x ∈ x"
by (rule AC_M_func) (simp_all add: non_empty_family)

lemma AC_M_func_Pow_rel:
assumes "M(C)"
shows "∃f ∈ (Pow⇗M⇖(C)-{0}) →⇗M⇖ C. ∀x ∈ Pow⇗M⇖(C)-{0}. f`x ∈ x"
proof -
have "0∉Pow⇗M⇖(C)-{0}" by simp
with assms
obtain f where "f ∈ (Pow⇗M⇖(C)-{0}) →⇗M⇖ ⋃(Pow⇗M⇖(C)-{0})" "∀x ∈ Pow⇗M⇖(C)-{0}. f`x ∈ x"
using AC_M_func0[OF ‹0∉_›] by auto
moreover
have "x⊆C" if "x ∈ Pow⇗M⇖(C) - {0}" for x
using that Pow_rel_char assms
by auto
moreover
have "⋃(Pow⇗M⇖(C) - {0}) ⊆ C"
using assms Pow_rel_char by auto
ultimately
show ?thesis
using assms function_space_rel_char
by (rule_tac bexI,auto,rule_tac Pi_weaken_type,simp_all)
qed

theorem pointed_DC:
assumes "∀x∈A. ∃y∈A. ⟨x,y⟩∈ R" "M(A)" "M(R)"
shows "∀a∈A. ∃f ∈ nat→⇗M⇖ A. f`0 = a ∧ (∀n ∈ nat. ⟨f`n,f`succ(n)⟩∈R)"
proof -
have 0:"∀y∈A. {x ∈ A . ⟨y, x⟩ ∈ R} ≠ 0"
using assms by auto
from ‹M(A)›
obtain g where 1: "g ∈ Pow⇗M⇖(A)-{0} → A" "∀X[M]. X ≠ 0 ∧ X ⊆ A ⟶ g ` X ∈ X"
"M(g)"
using AC_M_func_Pow_rel[of A] mem_Pow_rel_abs
function_space_rel_char[of "Pow⇗M⇖(A)-{0}" A] by auto
then
have 2:"∀X[M]. X ≠ 0 ∧ X ⊆ A ⟶ g ` X ∈ A" by auto
{
fix a
assume "a∈A"
let ?f ="λn∈nat. dc_witness(n,A,a,g,R)"
note ‹a∈A›
moreover from this
have f0: "?f`0 = a" by simp
moreover
note ‹a∈A› ‹M(g)› ‹M(A)› ‹M(R)›
moreover from calculation
have "⟨?f ` n, ?f ` succ(n)⟩ ∈ R" if "n∈nat" for n
using witness_related[OF ‹a∈A› _ 0, of g n] 1 that
by (auto dest:transM)
ultimately
have "∃f[M]. f∈nat → A ∧ f ` 0 = a ∧ (∀n∈nat. ⟨f ` n, f ` succ(n)⟩ ∈ R)"
using 0 1 ‹a∈_›
by (rule_tac x="(λn∈ω. dc_witness(n, A, a, g, R))" in rexI)
(simp_all, rule_tac witness_funtype,
auto intro!: Lambda_dc_witness_closed dest:transM)
}
with ‹M(A)›
show ?thesis using function_space_rel_char by auto
qed

lemma aux_DC_on_AxNat2 : "∀x∈A×nat. ∃y∈A. ⟨x,⟨y,succ(snd(x))⟩⟩ ∈ R ⟹
∀x∈A×nat. ∃y∈A×nat. ⟨x,y⟩ ∈ {⟨a,b⟩∈R. snd(b) = succ(snd(a))}"
by (rule ballI, erule_tac x="x" in ballE, simp_all)

lemma infer_snd : "c∈ A×B ⟹ snd(c) = k ⟹ c=⟨fst(c),k⟩"
by auto

corollary DC_on_A_x_nat :
assumes "(∀x∈A×nat. ∃y∈A. ⟨x,⟨y,succ(snd(x))⟩⟩ ∈ R)" "a∈A" "M(A)" "M(R)"
shows "∃f ∈ nat→⇗M⇖A. f`0 = a ∧ (∀n ∈ nat. ⟨⟨f`n,n⟩,⟨f`succ(n),succ(n)⟩⟩∈R)" (is "∃x∈_.?P(x)")
proof -
let ?R'="{⟨a,b⟩∈R. snd(b) = succ(snd(a))}"
from assms(1)
have "∀x∈A×nat. ∃y∈A×nat. ⟨x,y⟩ ∈ ?R'"
using aux_DC_on_AxNat2 by simp
moreover
note ‹a∈_› ‹M(A)›
moreover from this
have "M(A × ω)" by simp
have "lam_replacement(M, λx. succ(snd(fst(x))))"
using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
lam_replacement_hcomp[of _ "λx. succ(snd(x))"]
lam_replacement_succ by simp
with ‹M(R)›
have "M(?R')"
using separation_eq lam_replacement_fst lam_replacement_snd
lam_replacement_succ lam_replacement_hcomp lam_replacement_identity
unfolding split_def by simp
ultimately
obtain f where
F:"f∈nat→⇗M⇖ A×ω" "f ` 0 = ⟨a,0⟩"  "∀n∈nat. ⟨f ` n, f ` succ(n)⟩ ∈ ?R'"
using pointed_DC[of "A×nat" ?R'] by blast
with ‹M(A)›
have "M(f)" using function_space_rel_char by simp
then
have "M(λx∈nat. fst(f`x))" (is "M(?f)")
using lam_replacement_fst lam_replacement_hcomp
lam_replacement_constant lam_replacement_identity
lam_replacement_apply
by (rule_tac lam_replacement_imp_lam_closed, auto)
with F ‹M(A)›
have "?f∈nat→⇗M⇖ A" "?f ` 0 = a" using function_space_rel_char by auto
have 1:"n∈ nat ⟹ f`n= ⟨?f`n, n⟩" for n
proof(induct n set:nat)
case 0
then show ?case using F by simp
next
case (succ x)
with ‹M(A)›
have "⟨f`x, f`succ(x)⟩ ∈ ?R'" "f`x ∈ A×nat" "f`succ(x)∈A×nat"
using F function_space_rel_char[of ω "A×ω"] by auto
then
have "snd(f`succ(x)) = succ(snd(f`x))" by simp
with succ ‹f`x∈_›
show ?case using infer_snd[OF ‹f`succ(_)∈_›] by auto
qed
have "⟨⟨?f`n,n⟩,⟨?f`succ(n),succ(n)⟩⟩ ∈ R" if "n∈nat" for n
using that 1[of "succ(n)"] 1[OF ‹n∈_›] F(3) by simp
with ‹f`0=⟨a,0⟩›
show ?thesis
using rev_bexI[OF ‹?f∈_›] by simp
qed

lemma aux_sequence_DC :
assumes "∀x∈A. ∀n∈nat. ∃y∈A. ⟨x,y⟩ ∈ S`n"
"R={⟨⟨x,n⟩,⟨y,m⟩⟩ ∈ (A×nat)×(A×nat). ⟨x,y⟩∈S`m }"
shows "∀ x∈A×nat . ∃y∈A. ⟨x,⟨y,succ(snd(x))⟩⟩ ∈ R"
using assms Pair_fst_snd_eq by auto

lemma aux_sequence_DC2 : "∀x∈A. ∀n∈nat. ∃y∈A. ⟨x,y⟩ ∈ S`n ⟹
∀x∈A×nat. ∃y∈A. ⟨x,⟨y,succ(snd(x))⟩⟩ ∈ {⟨⟨x,n⟩,⟨y,m⟩⟩∈(A×nat)×(A×nat). ⟨x,y⟩∈S`m }"
by auto

lemma sequence_DC:
assumes "∀x∈A. ∀n∈nat. ∃y∈A. ⟨x,y⟩ ∈ S`n" "M(A)" "M(S)"
shows "∀a∈A. (∃f ∈ nat→⇗M⇖ A. f`0 = a ∧ (∀n ∈ nat. ⟨f`n,f`succ(n)⟩∈S`succ(n)))"
proof -
from ‹M(S)›
have "lam_replacement(M, λx. S ` snd(snd(x)))"
using lam_replacement_snd lam_replacement_hcomp
lam_replacement_hcomp[of _ "λx. S`snd(x)"] lam_replacement_apply by simp
with assms
have "M({x ∈ (A × ω) × A × ω . (λ⟨⟨x,n⟩,y,m⟩. ⟨x, y⟩ ∈ S ` m)(x)})"
using lam_replacement_fst lam_replacement_snd lam_replacement_apply[of S]
lam_replacement_product[of "λx. fst(fst(x))" "λx. fst(snd(x))",
THEN [2] separation_in, of "λx. S ` snd(snd(x))"]
lam_replacement_hcomp unfolding split_def by simp
with assms
show ?thesis
by (rule_tac ballI) (drule aux_sequence_DC2, drule DC_on_A_x_nat, auto)
qed

end ― ‹\<^locale>‹M_library_DC››

end```