Theory Forces_Definition

```section‹The definition of \<^term>‹forces››

theory Forces_Definition
imports
Forcing_Data
begin

text‹This is the core of our development.›

subsection‹The relation \<^term>‹frecrel››

lemma names_belowsD:
assumes "x ∈ names_below(P,z)"
obtains f n1 n2 p where
"x = ⟨f,n1,n2,p⟩" "f∈2" "n1∈ecloseN(z)" "n2∈ecloseN(z)" "p∈P"
using assms unfolding names_below_def by auto

context forcing_data1
begin

(* Absoluteness of components *)
lemma ftype_abs:
"⟦x∈M; y∈M ⟧ ⟹ is_ftype(##M,x,y) ⟷ y = ftype(x)"
unfolding ftype_def is_ftype_def by (simp add:absolut)

lemma name1_abs:
"⟦x∈M; y∈M ⟧ ⟹ is_name1(##M,x,y) ⟷ y = name1(x)"
unfolding name1_def is_name1_def
by (rule is_hcomp_abs[OF fst_abs],simp_all add: fst_snd_closed[simplified] absolut)

lemma snd_snd_abs:
"⟦x∈M; y∈M ⟧ ⟹ is_snd_snd(##M,x,y) ⟷ y = snd(snd(x))"
unfolding is_snd_snd_def
by (rule is_hcomp_abs[OF snd_abs],

lemma name2_abs:
"⟦x∈M; y∈M ⟧ ⟹ is_name2(##M,x,y) ⟷ y = name2(x)"
unfolding name2_def is_name2_def
by (rule is_hcomp_abs[OF fst_abs snd_snd_abs],simp_all add:absolut conjunct2[OF fst_snd_closed,simplified])

lemma cond_of_abs:
"⟦x∈M; y∈M ⟧ ⟹ is_cond_of(##M,x,y) ⟷ y = cond_of(x)"
unfolding cond_of_def is_cond_of_def
by (rule is_hcomp_abs[OF snd_abs snd_snd_abs];simp_all add:fst_snd_closed[simplified])

lemma tuple_abs:
"⟦z∈M;t1∈M;t2∈M;p∈M;t∈M⟧ ⟹
is_tuple(##M,z,t1,t2,p,t) ⟷ t = ⟨z,t1,t2,p⟩"
unfolding is_tuple_def using pair_in_M_iff by simp

lemmas components_abs = ftype_abs name1_abs name2_abs cond_of_abs
tuple_abs

lemma comp_in_M:
"p ≼ q ⟹ p∈M"
"p ≼ q ⟹ q∈M"
using transitivity[of _ leq] pair_in_M_iff by auto

(* Absoluteness of Hfrc *)

lemma eq_case_abs [simp]:
assumes "t1∈M" "t2∈M" "p∈M" "f∈M"
shows "is_eq_case(##M,t1,t2,p,ℙ,leq,f) ⟷ eq_case(t1,t2,p,ℙ,leq,f)"
proof -
have "q ≼ p ⟹ q∈M" for q
using comp_in_M by simp
moreover
have "⟨s,y⟩∈t ⟹ s∈domain(t)" if "t∈M" for s y t
using that unfolding domain_def by auto
ultimately
have
"(∀s∈M. s ∈ domain(t1) ∨ s ∈ domain(t2) ⟶ (∀q∈M. q∈ℙ ∧ q ≼ p ⟶
(f ` ⟨1, s, t1, q⟩ =1 ⟷ f ` ⟨1, s, t2, q⟩=1))) ⟷
(∀s. s ∈ domain(t1) ∨ s ∈ domain(t2) ⟶ (∀q. q∈ℙ ∧ q ≼ p ⟶
(f ` ⟨1, s, t1, q⟩ =1 ⟷ f ` ⟨1, s, t2, q⟩=1)))"
using assms domain_trans[OF trans_M,of t1] domain_trans[OF trans_M,of t2]
by auto
then
show ?thesis
unfolding eq_case_def is_eq_case_def
using assms pair_in_M_iff nat_into_M domain_closed apply_closed zero_in_M Un_closed
qed

lemma mem_case_abs [simp]:
assumes "t1∈M" "t2∈M" "p∈M" "f∈M"
shows "is_mem_case(##M,t1,t2,p,ℙ,leq,f) ⟷ mem_case(t1,t2,p,ℙ,leq,f)"
proof
{
fix v
assume "v∈ℙ" "v ≼ p" "is_mem_case(##M,t1,t2,p,ℙ,leq,f)"
moreover
from this
have "v∈M" "⟨v,p⟩ ∈ M" "(##M)(v)"
using transitivity[OF _ P_in_M,of v] transitivity[OF _ leq_in_M]
by simp_all
moreover
from calculation assms
obtain q r s where
"r ∈ ℙ ∧ q ∈ ℙ ∧ ⟨q, v⟩ ∈ M ∧ ⟨s, r⟩ ∈ M ∧ ⟨q, r⟩ ∈ M ∧ 0 ∈ M ∧
⟨0, t1, s, q⟩ ∈ M ∧ q ≼ v ∧ ⟨s, r⟩ ∈ t2 ∧ q ≼ r ∧ f ` ⟨0, t1, s, q⟩ = 1"
unfolding is_mem_case_def by (auto simp add:components_abs)
then
have "∃q s r. r ∈ ℙ ∧ q ∈ ℙ ∧ q ≼ v ∧ ⟨s, r⟩ ∈ t2 ∧ q ≼ r ∧ f ` ⟨0, t1, s, q⟩ = 1"
by auto
}
then
show "mem_case(t1, t2, p, ℙ, leq, f)" if "is_mem_case(##M, t1, t2, p, ℙ, leq, f)"
unfolding mem_case_def using that assms by auto
next
{ fix v
assume "v ∈ M" "v ∈ ℙ" "⟨v, p⟩ ∈ M" "v ≼ p" "mem_case(t1, t2, p, ℙ, leq, f)"
moreover
from this
obtain q s r where "r ∈ ℙ ∧ q ∈ ℙ ∧ q ≼ v ∧ ⟨s, r⟩ ∈ t2 ∧ q ≼ r ∧ f ` ⟨0, t1, s, q⟩ = 1"
unfolding mem_case_def by auto
moreover
from this ‹t2∈M›
have "r∈M" "q∈M" "s∈M" "r ∈ ℙ ∧ q ∈ ℙ ∧ q ≼ v ∧ ⟨s, r⟩ ∈ t2 ∧ q ≼ r ∧ f ` ⟨0, t1, s, q⟩ = 1"
using transitivity domainI[of s r] domain_closed
by auto
moreover
note ‹t1∈M›
ultimately
have "∃q∈M . ∃s∈M. ∃r∈M.
r ∈ ℙ ∧ q ∈ ℙ ∧ ⟨q, v⟩ ∈ M ∧ ⟨s, r⟩ ∈ M ∧ ⟨q, r⟩ ∈ M ∧ 0 ∈ M ∧
⟨0, t1, s, q⟩ ∈ M ∧ q ≼ v ∧ ⟨s, r⟩ ∈ t2 ∧ q ≼ r ∧ f ` ⟨0, t1, s, q⟩ = 1"
using pair_in_M_iff zero_in_M by auto
}
then
show "is_mem_case(##M, t1, t2, p, ℙ, leq, f)" if "mem_case(t1, t2, p, ℙ, leq, f)"
unfolding is_mem_case_def
using assms that zero_in_M pair_in_M_iff apply_closed nat_into_M
qed

lemma Hfrc_abs:
"⟦fnnc∈M; f∈M⟧ ⟹
is_Hfrc(##M,ℙ,leq,fnnc,f) ⟷ Hfrc(ℙ,leq,fnnc,f)"
unfolding is_Hfrc_def Hfrc_def using pair_in_M_iff zero_in_M

lemma Hfrc_at_abs:
"⟦fnnc∈M; f∈M ; z∈M⟧ ⟹
is_Hfrc_at(##M,ℙ,leq,fnnc,f,z) ⟷  z = bool_of_o(Hfrc(ℙ,leq,fnnc,f)) "
unfolding is_Hfrc_at_def using Hfrc_abs
by auto

lemma components_closed :
"x∈M ⟹ (##M)(ftype(x))"
"x∈M ⟹ (##M)(name1(x))"
"x∈M ⟹ (##M)(name2(x))"
"x∈M ⟹ (##M)(cond_of(x))"
unfolding ftype_def name1_def name2_def cond_of_def using fst_snd_closed by simp_all

lemma ecloseN_closed:
"(##M)(A) ⟹ (##M)(ecloseN(A))"
"(##M)(A) ⟹ (##M)(eclose_n(name1,A))"
"(##M)(A) ⟹ (##M)(eclose_n(name2,A))"
unfolding ecloseN_def eclose_n_def
using components_closed eclose_closed singleton_closed Un_closed by auto

lemma eclose_n_abs :
assumes "x∈M" "ec∈M"
shows "is_eclose_n(##M,is_name1,ec,x) ⟷ ec = eclose_n(name1,x)"
"is_eclose_n(##M,is_name2,ec,x) ⟷ ec = eclose_n(name2,x)"
unfolding is_eclose_n_def eclose_n_def
using assms name1_abs name2_abs eclose_abs singleton_closed components_closed
by auto

lemma ecloseN_abs :
"⟦x∈M;ec∈M⟧ ⟹ is_ecloseN(##M,x,ec) ⟷ ec = ecloseN(x)"
unfolding is_ecloseN_def ecloseN_def
using eclose_n_abs Un_closed union_abs ecloseN_closed
by auto

lemma frecR_abs :
"x∈M ⟹ y∈M ⟹ frecR(x,y) ⟷ is_frecR(##M,x,y)"
unfolding frecR_def is_frecR_def
using zero_in_M domain_closed Un_closed components_closed nat_into_M

lemma frecrelP_abs :
"z∈M ⟹ frecrelP(##M,z) ⟷ (∃x y. z = ⟨x,y⟩ ∧ frecR(x,y))"
using pair_in_M_iff frecR_abs unfolding frecrelP_def by auto

lemma frecrel_abs:
assumes "A∈M" "r∈M"
shows "is_frecrel(##M,A,r) ⟷  r = frecrel(A)"
proof -
from ‹A∈M›
have "z∈M" if "z∈A×A" for z
using cartprod_closed transitivity that by simp
then
have "Collect(A×A,frecrelP(##M)) = Collect(A×A,λz. (∃x y. z = ⟨x,y⟩ ∧ frecR(x,y)))"
using Collect_cong[of "A×A" "A×A" "frecrelP(##M)"] assms frecrelP_abs by simp
with assms
show ?thesis
unfolding is_frecrel_def def_frecrel using cartprod_closed
by simp
qed

lemma frecrel_closed:
assumes "x∈M"
shows "frecrel(x)∈M"
proof -
have "Collect(x×x,λz. (∃x y. z = ⟨x,y⟩ ∧ frecR(x,y)))∈M"
using Collect_in_M[of "frecrelP_fm(0)" "[]"] arity_frecrelP_fm sats_frecrelP_fm
frecrelP_abs ‹x∈M› cartprod_closed
by simp
then
show ?thesis
unfolding frecrel_def Rrel_def frecrelP_def by simp
qed

lemma field_frecrel : "field(frecrel(names_below(ℙ,x))) ⊆ names_below(ℙ,x)"
unfolding frecrel_def
using field_Rrel by simp

lemma forcerelD : "uv ∈ forcerel(ℙ,x) ⟹ uv∈ names_below(ℙ,x) × names_below(ℙ,x)"
unfolding forcerel_def
using trancl_type field_frecrel by blast

lemma wf_forcerel :
"wf(forcerel(ℙ,x))"
unfolding forcerel_def using wf_trancl wf_frecrel .

lemma restrict_trancl_forcerel:
assumes "frecR(w,y)"
shows "restrict(f,frecrel(names_below(ℙ,x))-``{y})`w
= restrict(f,forcerel(ℙ,x)-``{y})`w"
unfolding forcerel_def frecrel_def using assms restrict_trancl_Rrel[of frecR]
by simp

lemma names_belowI :
assumes "frecR(⟨ft,n1,n2,p⟩,⟨a,b,c,d⟩)" "p∈ℙ"
shows "⟨ft,n1,n2,p⟩ ∈ names_below(ℙ,⟨a,b,c,d⟩)" (is "?x ∈ names_below(_,?y)")
proof -
from assms
have "ft ∈ 2" "a ∈ 2"
unfolding frecR_def by (auto simp add:components_simp)
from assms
consider (eq) "n1 ∈ domain(b) ∪ domain(c) ∧ (n2 = b ∨ n2 =c)"
| (mem) "n1 = b ∧ n2 ∈ domain(c)"
unfolding frecR_def by (auto simp add:components_simp)
then show ?thesis
proof cases
case eq
then
have "n1 ∈ eclose(b) ∨ n1 ∈ eclose(c)"
using Un_iff in_dom_in_eclose by auto
with eq
have "n1 ∈ ecloseN(?y)" "n2 ∈ ecloseN(?y)"
using ecloseNI components_in_eclose by auto
with ‹ft∈2› ‹p∈ℙ›
show ?thesis
unfolding names_below_def by  auto
next
case mem
then
have "n1 ∈ ecloseN(?y)" "n2 ∈ ecloseN(?y)"
using mem_eclose_trans ecloseNI in_dom_in_eclose components_in_eclose
by auto
with ‹ft∈2› ‹p∈ℙ›
show ?thesis
unfolding names_below_def
by auto
qed
qed

lemma names_below_tr :
assumes "x∈ names_below(ℙ,y)" "y∈ names_below(ℙ,z)"
shows "x∈ names_below(ℙ,z)"
proof -
let ?A="λy . names_below(ℙ,y)"
note assms
moreover from this
obtain fx x1 x2 px where "x = ⟨fx,x1,x2,px⟩" "fx∈2" "x1∈ecloseN(y)" "x2∈ecloseN(y)" "px∈ℙ"
unfolding names_below_def by auto
moreover from calculation
obtain fy y1 y2 py where "y = ⟨fy,y1,y2,py⟩" "fy∈2" "y1∈ecloseN(z)" "y2∈ecloseN(z)" "py∈ℙ"
unfolding names_below_def by auto
moreover from calculation
have "x1∈ecloseN(z)" "x2∈ecloseN(z)"
using ecloseN_mono names_simp by auto
ultimately
have "x∈?A(z)"
unfolding names_below_def by simp
then
show ?thesis using subsetI by simp
qed

lemma arg_into_names_below2 :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ,z))"
shows  "x ∈ names_below(ℙ,y)"
proof -
from assms
have "x∈names_below(ℙ,z)" "y∈names_below(ℙ,z)" "frecR(x,y)"
unfolding frecrel_def Rrel_def
by auto
obtain f n1 n2 p where "x = ⟨f,n1,n2,p⟩" "f∈2" "n1∈ecloseN(z)" "n2∈ecloseN(z)" "p∈ℙ"
using ‹x∈names_below(ℙ,z)›
unfolding names_below_def by auto
moreover
obtain fy m1 m2 q where "q∈ℙ" "y = ⟨fy,m1,m2,q⟩"
using ‹y∈names_below(ℙ,z)›
unfolding names_below_def by auto
moreover
note ‹frecR(x,y)›
ultimately
show ?thesis
using names_belowI by simp
qed

lemma arg_into_names_below :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ,z))"
shows  "x ∈ names_below(ℙ,x)"
proof -
from assms
have "x∈names_below(ℙ,z)"
unfolding frecrel_def Rrel_def
by auto
from ‹x∈names_below(ℙ,z)›
obtain f n1 n2 p where
"x = ⟨f,n1,n2,p⟩" "f∈2" "n1∈ecloseN(z)" "n2∈ecloseN(z)" "p∈ℙ"
unfolding names_below_def by auto
then
have "n1∈ecloseN(x)" "n2∈ecloseN(x)"
using components_in_eclose by simp_all
with ‹f∈2› ‹p∈ℙ› ‹x = ⟨f,n1,n2,p⟩›
show ?thesis
unfolding names_below_def by simp
qed

lemma forcerel_arg_into_names_below :
assumes "⟨x,y⟩ ∈ forcerel(ℙ,z)"
shows  "x ∈ names_below(ℙ,x)"
using assms
unfolding forcerel_def

lemma names_below_mono :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ,z))"
shows "names_below(ℙ,x) ⊆ names_below(ℙ,y)"
proof -
from assms
have "x∈names_below(ℙ,y)"
using arg_into_names_below2 by simp
then
show ?thesis
using names_below_tr subsetI by simp
qed

lemma frecrel_mono :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ,z))"
shows "frecrel(names_below(ℙ,x)) ⊆ frecrel(names_below(ℙ,y))"
unfolding frecrel_def
using Rrel_mono names_below_mono assms by simp

lemma forcerel_mono2 :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ,z))"
shows "forcerel(ℙ,x) ⊆ forcerel(ℙ,y)"
unfolding forcerel_def
using trancl_mono frecrel_mono assms by simp

lemma forcerel_mono_aux :
assumes "⟨x,y⟩ ∈ frecrel(names_below(ℙ, w))^+"
shows "forcerel(ℙ,x) ⊆ forcerel(ℙ,y)"
using assms
by (rule trancl_induct,simp_all add: subset_trans forcerel_mono2)

lemma forcerel_mono :
assumes "⟨x,y⟩ ∈ forcerel(ℙ,z)"
shows "forcerel(ℙ,x) ⊆ forcerel(ℙ,y)"
using forcerel_mono_aux assms unfolding forcerel_def by simp

lemma forcerel_eq_aux: "x ∈ names_below(ℙ, w) ⟹ ⟨x,y⟩ ∈ forcerel(ℙ,z) ⟹
(y ∈ names_below(ℙ, w) ⟶ ⟨x,y⟩ ∈ forcerel(ℙ,w))"
unfolding forcerel_def
proof (rule_tac a=x and b=y and
P="λ y . y ∈ names_below(ℙ, w) ⟶ ⟨x,y⟩ ∈ frecrel(names_below(ℙ,w))^+" in trancl_induct,simp)
let ?A="λ a . names_below(ℙ, a)"
let ?R="λ a . frecrel(?A(a))"
let ?fR="λ a .forcerel(a)"
show "u∈?A(w) ⟶ ⟨x,u⟩∈?R(w)^+" if "x∈?A(w)" "⟨x,y⟩∈?R(z)^+" "⟨x,u⟩∈?R(z)"  for  u
using that frecrelD frecrelI r_into_trancl
unfolding names_below_def by simp
{
fix u v
assume "x ∈ ?A(w)"
"⟨x, y⟩ ∈ ?R(z)^+"
"⟨x, u⟩ ∈ ?R(z)^+"
"⟨u, v⟩ ∈ ?R(z)"
"u ∈ ?A(w) ⟹ ⟨x, u⟩ ∈ ?R(w)^+"
then
have "v ∈ ?A(w) ⟹ ⟨x, v⟩ ∈ ?R(w)^+"
proof -
assume "v ∈?A(w)"
from ‹⟨u,v⟩∈_›
have "u∈?A(v)"
using arg_into_names_below2 by simp
with ‹v ∈?A(w)›
have "u∈?A(w)"
using names_below_tr by simp
with ‹v∈_› ‹⟨u,v⟩∈_›
have "⟨u,v⟩∈ ?R(w)"
using frecrelD frecrelI r_into_trancl unfolding names_below_def by simp
with ‹u ∈ ?A(w) ⟹ ⟨x, u⟩ ∈ ?R(w)^+› ‹u∈?A(w)›
have "⟨x, u⟩ ∈ ?R(w)^+"
by simp
with ‹⟨u,v⟩∈ ?R(w)›
show "⟨x,v⟩∈ ?R(w)^+" using trancl_trans r_into_trancl
by simp
qed
}
then
show "v ∈ ?A(w) ⟶ ⟨x, v⟩ ∈ ?R(w)^+"
if "x ∈ ?A(w)"
"⟨x, y⟩ ∈ ?R(z)^+"
"⟨x, u⟩ ∈ ?R(z)^+"
"⟨u, v⟩ ∈ ?R(z)"
"u ∈ ?A(w) ⟶ ⟨x, u⟩ ∈ ?R(w)^+" for u v
using that
by simp
qed

lemma forcerel_eq :
assumes "⟨z,x⟩ ∈ forcerel(ℙ,x)"
shows "forcerel(ℙ,z) = forcerel(ℙ,x) ∩ names_below(ℙ,z)×names_below(ℙ,z)"
using assms forcerel_eq_aux forcerelD forcerel_mono[of z x x] subsetI
by auto

lemma forcerel_below_aux :
assumes "⟨z,x⟩ ∈ forcerel(ℙ,x)" "⟨u,z⟩ ∈ forcerel(ℙ,x)"
shows "u ∈ names_below(ℙ,z)"
using assms(2)
unfolding forcerel_def
proof(rule trancl_induct)
show  "u ∈ names_below(ℙ,y)" if " ⟨u, y⟩ ∈ frecrel(names_below(ℙ, x))" for y
using that vimage_singleton_iff arg_into_names_below2 by simp
next
show "u ∈ names_below(ℙ,z)"
if "⟨u, y⟩ ∈ frecrel(names_below(ℙ, x))^+"
"⟨y, z⟩ ∈ frecrel(names_below(ℙ, x))"
"u ∈ names_below(ℙ, y)"
for y z
using that arg_into_names_below2[of y z x] names_below_tr by simp
qed

lemma forcerel_below :
assumes "⟨z,x⟩ ∈ forcerel(ℙ,x)"
shows "forcerel(ℙ,x) -`` {z} ⊆ names_below(ℙ,z)"
using vimage_singleton_iff assms forcerel_below_aux by auto

lemma relation_forcerel :
shows "relation(forcerel(ℙ,z))" "trans(forcerel(ℙ,z))"
unfolding forcerel_def using relation_trancl trans_trancl by simp_all

lemma Hfrc_restrict_trancl: "bool_of_o(Hfrc(ℙ, leq, y, restrict(f,frecrel(names_below(ℙ,x))-``{y})))
= bool_of_o(Hfrc(ℙ, leq, y, restrict(f,(frecrel(names_below(ℙ,x))^+)-``{y})))"
unfolding Hfrc_def bool_of_o_def eq_case_def mem_case_def
using restrict_trancl_forcerel frecRI1 frecRI2 frecRI3
unfolding forcerel_def
by simp

(* Recursive definition of forces for atomic formulas using a transitive relation *)
lemma frc_at_trancl: "frc_at(ℙ,leq,z) = wfrec(forcerel(ℙ,z),z,λx f. bool_of_o(Hfrc(ℙ,leq,x,f)))"
unfolding frc_at_def forcerel_def using wf_eq_trancl Hfrc_restrict_trancl by simp

lemma forcerelI1 :
assumes "n1 ∈ domain(b) ∨ n1 ∈ domain(c)" "p∈ℙ" "d∈ℙ"
shows "⟨⟨1, n1, b, p⟩, ⟨0,b,c,d⟩⟩∈ forcerel(ℙ,⟨0,b,c,d⟩)"
proof -
let ?x="⟨1, n1, b, p⟩"
let ?y="⟨0,b,c,d⟩"
from assms
have "frecR(?x,?y)"
using frecRI1 by simp
then
have "?x∈names_below(ℙ,?y)" "?y ∈ names_below(ℙ,?y)"
using names_belowI  assms components_in_eclose
unfolding names_below_def by auto
with ‹frecR(?x,?y)›
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed

lemma forcerelI2 :
assumes "n1 ∈ domain(b) ∨ n1 ∈ domain(c)" "p∈ℙ" "d∈ℙ"
shows "⟨⟨1, n1, c, p⟩, ⟨0,b,c,d⟩⟩∈ forcerel(ℙ,⟨0,b,c,d⟩)"
proof -
let ?x="⟨1, n1, c, p⟩"
let ?y="⟨0,b,c,d⟩"
note assms
moreover from this
have "frecR(?x,?y)"
using frecRI2 by simp
moreover from calculation
have "?x∈names_below(ℙ,?y)" "?y ∈ names_below(ℙ,?y)"
using names_belowI components_in_eclose
unfolding names_below_def by auto
ultimately
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed

lemma forcerelI3 :
assumes "⟨n2, r⟩ ∈ c" "p∈ℙ" "d∈ℙ" "r ∈ ℙ"
shows "⟨⟨0, b, n2, p⟩,⟨1, b, c, d⟩⟩ ∈ forcerel(ℙ,⟨1,b,c,d⟩)"
proof -
let ?x="⟨0, b, n2, p⟩"
let ?y="⟨1, b, c, d⟩"
note assms
moreover from this
have "frecR(?x,?y)"
using frecRI3 by simp
moreover from calculation
have "?x∈names_below(ℙ,?y)"  "?y ∈ names_below(ℙ,?y)"
using names_belowI components_in_eclose
unfolding names_below_def by auto
ultimately
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed

lemmas forcerelI = forcerelI1[THEN vimage_singleton_iff[THEN iffD2]]
forcerelI2[THEN vimage_singleton_iff[THEN iffD2]]
forcerelI3[THEN vimage_singleton_iff[THEN iffD2]]

lemma  aux_def_frc_at:
assumes "z ∈ forcerel(ℙ,x) -`` {x}"
shows "wfrec(forcerel(ℙ,x), z, H) =  wfrec(forcerel(ℙ,z), z, H)"
proof -
let ?A="names_below(ℙ,z)"
from assms
have "⟨z,x⟩ ∈ forcerel(ℙ,x)"
using vimage_singleton_iff by simp
moreover from this
have "z ∈ ?A"
using forcerel_arg_into_names_below by simp
moreover from calculation
have "forcerel(ℙ,z) = forcerel(ℙ,x) ∩ (?A×?A)"
"forcerel(ℙ,x) -`` {z} ⊆ ?A"
using forcerel_eq forcerel_below
by auto
moreover from calculation
have "wfrec(forcerel(ℙ,x), z, H) = wfrec[?A](forcerel(ℙ,x), z, H)"
using wfrec_trans_restr[OF relation_forcerel(1) wf_forcerel relation_forcerel(2), of x z ?A]
by simp
ultimately
show ?thesis
using wfrec_restr_eq by simp
qed

subsection‹Recursive expression of \<^term>‹frc_at››

lemma def_frc_at :
assumes "p∈ℙ"
shows
"frc_at(ℙ,leq,⟨ft,n1,n2,p⟩) =
bool_of_o( p ∈ℙ ∧
(  ft = 0 ∧  (∀s. s∈domain(n1) ∪ domain(n2) ⟶
(∀q. q∈ℙ ∧ q ≼ p ⟶ (frc_at(ℙ,leq,⟨1,s,n1,q⟩) =1 ⟷ frc_at(ℙ,leq,⟨1,s,n2,q⟩) =1)))
∨ ft = 1 ∧ ( ∀v∈ℙ. v ≼ p ⟶
(∃q. ∃s. ∃r. r∈ℙ ∧ q∈ℙ ∧ q ≼ v ∧ ⟨s,r⟩ ∈ n2 ∧ q ≼ r ∧  frc_at(ℙ,leq,⟨0,n1,s,q⟩) = 1))))"
proof -
let ?r="λy. forcerel(ℙ,y)" and ?Hf="λx f. bool_of_o(Hfrc(ℙ,leq,x,f))"
let ?t="λy. ?r(y) -`` {y}"
let ?arg="⟨ft,n1,n2,p⟩"
from wf_forcerel
have wfr: "∀w . wf(?r(w))" ..
with wfrec [of "?r(?arg)" ?arg ?Hf]
have "frc_at(ℙ,leq,?arg) = ?Hf( ?arg, λx∈?r(?arg) -`` {?arg}. wfrec(?r(?arg), x, ?Hf))"
using frc_at_trancl by simp
also
have " ... = ?Hf( ?arg, λx∈?r(?arg) -`` {?arg}. frc_at(ℙ,leq,x))"
using aux_def_frc_at frc_at_trancl by simp
finally
show ?thesis
unfolding Hfrc_def mem_case_def eq_case_def
using forcerelI  assms
by auto
qed

subsection‹Absoluteness of \<^term>‹frc_at››

lemma forcerel_in_M :
assumes "x∈M"
shows "forcerel(ℙ,x)∈M"
unfolding forcerel_def def_frecrel names_below_def
proof -
let ?Q = "2 × ecloseN(x) × ecloseN(x) × ℙ"
have "?Q × ?Q ∈ M"
using ‹x∈M› nat_into_M ecloseN_closed cartprod_closed by simp
moreover
have "separation(##M,λz. frecrelP(##M,z))"
using separation_in_ctm[of "frecrelP_fm(0)",OF _ _ _ sats_frecrelP_fm]
arity_frecrelP_fm frecrelP_fm_type
by auto
moreover from this
have "separation(##M,λz. ∃x y. z = ⟨x, y⟩ ∧ frecR(x, y))"
using separation_cong[OF frecrelP_abs]
by force
ultimately
show "{z ∈ ?Q × ?Q . ∃x y. z = ⟨x, y⟩ ∧ frecR(x, y)}^+ ∈ M"
using separation_closed frecrelP_abs trancl_closed
by simp
qed

lemma relation2_Hfrc_at_abs:
"relation2(##M,is_Hfrc_at(##M,ℙ,leq),λx f. bool_of_o(Hfrc(ℙ,leq,x,f)))"
unfolding relation2_def using Hfrc_at_abs
by simp

lemma Hfrc_at_closed :
"∀x∈M. ∀g∈M. function(g) ⟶ bool_of_o(Hfrc(ℙ,leq,x,g))∈M"
unfolding bool_of_o_def using zero_in_M nat_into_M[of 1] by simp

lemma wfrec_Hfrc_at :
assumes "X∈M"
shows "wfrec_replacement(##M,is_Hfrc_at(##M,ℙ,leq),forcerel(ℙ,X))"
proof -
have 0:"is_Hfrc_at(##M,ℙ,leq,a,b,c) ⟷
sats(M,Hfrc_at_fm(8,9,2,1,0),[c,b,a,d,e,y,x,z,ℙ,leq,forcerel(ℙ,X)])"
if "a∈M" "b∈M" "c∈M" "d∈M" "e∈M" "y∈M" "x∈M" "z∈M"
for a b c d e y x z
using that ‹X∈M› forcerel_in_M
Hfrc_at_iff_sats[of concl:M ℙ leq a b c 8 9 2 1 0]
by simp
have 1:"sats(M,is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0),[y,x,z,ℙ,leq,forcerel(ℙ,X)]) ⟷
is_wfrec(##M, is_Hfrc_at(##M,ℙ,leq),forcerel(ℙ,X), x, y)"
if "x∈M" "y∈M" "z∈M" for x y z
using that ‹X∈M› forcerel_in_M sats_is_wfrec_fm[OF 0]
by simp
let
?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0)))"
have satsf:"sats(M, ?f, [x,z,ℙ,leq,forcerel(ℙ,X)]) ⟷
(∃y∈M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,ℙ,leq),forcerel(ℙ,X), x, y))"
if "x∈M" "z∈M" for x z
using that 1 ‹X∈M› forcerel_in_M by (simp del:pair_abs)
have artyf:"arity(?f) = 5"
using arity_wfrec_replacement_fm[where p="Hfrc_at_fm(8,9,2,1,0)" and i=10]
arity_Hfrc_at_fm ord_simp_union
by simp
moreover
have "?f∈formula" by simp
ultimately
have "strong_replacement(##M,λx z. sats(M,?f,[x,z,ℙ,leq,forcerel(ℙ,X)]))"
using ZF_ground_replacements(1) 1 artyf ‹X∈M› forcerel_in_M
unfolding replacement_assm_def wfrec_Hfrc_at_fm_def by simp
then
have "strong_replacement(##M,λx z.
∃y∈M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,ℙ,leq),forcerel(ℙ,X), x, y))"
using repl_sats[of M ?f "[ℙ,leq,forcerel(ℙ,X)]"] satsf by (simp del:pair_abs)
then
show ?thesis unfolding wfrec_replacement_def by simp
qed

lemma names_below_abs :
"⟦Q∈M;x∈M;nb∈M⟧ ⟹ is_names_below(##M,Q,x,nb) ⟷ nb = names_below(Q,x)"
unfolding is_names_below_def names_below_def
using succ_in_M_iff zero_in_M cartprod_closed ecloseN_abs ecloseN_closed
by auto

lemma names_below_closed:
"⟦Q∈M;x∈M⟧ ⟹ names_below(Q,x) ∈ M"
unfolding names_below_def
using zero_in_M cartprod_closed ecloseN_closed succ_in_M_iff
by simp

lemma "names_below_productE" :
assumes "Q ∈ M" "x ∈ M"
"⋀A1 A2 A3 A4. A1 ∈ M ⟹ A2 ∈ M ⟹ A3 ∈ M ⟹ A4 ∈ M ⟹ R(A1 × A2 × A3 × A4)"
shows "R(names_below(Q,x))"
unfolding names_below_def using assms nat_into_M ecloseN_closed[of x] by auto

lemma forcerel_abs :
"⟦x∈M;z∈M⟧ ⟹ is_forcerel(##M,ℙ,x,z) ⟷ z = forcerel(ℙ,x)"
unfolding is_forcerel_def forcerel_def
using frecrel_abs names_below_abs trancl_abs ecloseN_closed names_below_closed
names_below_productE[of concl:"λp. is_frecrel(##M,p,_) ⟷  _ = frecrel(p)"] frecrel_closed
by simp

lemma frc_at_abs:
assumes "fnnc∈M" "z∈M"
shows "is_frc_at(##M,ℙ,leq,fnnc,z) ⟷ z = frc_at(ℙ,leq,fnnc)"
proof -
from assms
have "(∃r∈M. is_forcerel(##M,ℙ,fnnc, r) ∧ is_wfrec(##M, is_Hfrc_at(##M, ℙ, leq), r, fnnc, z))
⟷ is_wfrec(##M, is_Hfrc_at(##M, ℙ, leq), forcerel(ℙ,fnnc), fnnc, z)"
using forcerel_abs forcerel_in_M by simp
then
show ?thesis
unfolding frc_at_trancl is_frc_at_def
using assms wfrec_Hfrc_at[of fnnc] wf_forcerel relation_forcerel forcerel_in_M
Hfrc_at_closed relation2_Hfrc_at_abs
trans_wfrec_abs[of "forcerel(ℙ,fnnc)" fnnc z "is_Hfrc_at(##M,ℙ,leq)" "λx f. bool_of_o(Hfrc(ℙ,leq,x,f))"]
by (simp flip:setclass_iff)
qed

lemma forces_eq'_abs :
"⟦p∈M ; t1∈M ; t2∈M⟧ ⟹ is_forces_eq'(##M,ℙ,leq,p,t1,t2) ⟷ forces_eq'(ℙ,leq,p,t1,t2)"
unfolding is_forces_eq'_def forces_eq'_def
using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)

lemma forces_mem'_abs :
"⟦p∈M ; t1∈M ; t2∈M⟧ ⟹ is_forces_mem'(##M,ℙ,leq,p,t1,t2) ⟷ forces_mem'(ℙ,leq,p,t1,t2)"
unfolding is_forces_mem'_def forces_mem'_def
using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)

lemma forces_neq'_abs :
assumes "p∈M" "t1∈M" "t2∈M"
shows "is_forces_neq'(##M,ℙ,leq,p,t1,t2) ⟷ forces_neq'(ℙ,leq,p,t1,t2)"
proof -
have "q∈M" if "q∈ℙ" for q
using that transitivity by simp
with assms
show ?thesis
unfolding is_forces_neq'_def forces_neq'_def
using forces_eq'_abs pair_in_M_iff
qed

lemma forces_nmem'_abs :
assumes "p∈M" "t1∈M" "t2∈M"
shows "is_forces_nmem'(##M,ℙ,leq,p,t1,t2) ⟷ forces_nmem'(ℙ,leq,p,t1,t2)"
proof -
have "q∈M" if "q∈ℙ" for q
using that transitivity by simp
with assms
show ?thesis
unfolding is_forces_nmem'_def forces_nmem'_def
using forces_mem'_abs pair_in_M_iff
qed

lemma leq_abs:
"⟦ l∈M ; q∈M ; p∈M ⟧ ⟹ is_leq(##M,l,q,p) ⟷ ⟨q,p⟩∈l"
unfolding is_leq_def using pair_in_M_iff by simp

subsection‹Forcing for atomic formulas in context›

definition
forces_eq :: "[i,i,i] ⇒ o" (‹_ forces⇩a '(_ = _')› [36,1,1] 60) where
"forces_eq ≡ forces_eq'(ℙ,leq)"

definition
forces_mem :: "[i,i,i] ⇒ o" (‹_ forces⇩a '(_ ∈ _')› [36,1,1] 60) where
"forces_mem ≡ forces_mem'(ℙ,leq)"

(* frc_at(ℙ,leq,⟨0,t1,t2,p⟩) = 1*)
abbreviation is_forces_eq
where "is_forces_eq ≡ is_forces_eq'(##M,ℙ,leq)"

(* frc_at(ℙ,leq,⟨1,t1,t2,p⟩) = 1*)
abbreviation
is_forces_mem :: "[i,i,i] ⇒ o" where
"is_forces_mem ≡ is_forces_mem'(##M,ℙ,leq)"

lemma def_forces_eq: "p∈ℙ ⟹ p forces⇩a (t1 = t2) ⟷
(∀s∈domain(t1) ∪ domain(t2). ∀q. q∈ℙ ∧ q ≼ p ⟶
(q forces⇩a (s ∈ t1) ⟷ q forces⇩a (s ∈ t2)))"
unfolding forces_eq_def forces_mem_def forces_eq'_def forces_mem'_def
using def_frc_at[of p 0 t1 t2 ]
unfolding bool_of_o_def
by auto

lemma def_forces_mem: "p∈ℙ ⟹ p forces⇩a (t1 ∈ t2) ⟷
(∀v∈ℙ. v ≼ p ⟶
(∃q. ∃s. ∃r. r∈ℙ ∧ q∈ℙ ∧ q ≼ v ∧ ⟨s,r⟩ ∈ t2 ∧ q ≼ r ∧ q forces⇩a (t1 = s)))"
unfolding forces_eq'_def forces_mem'_def forces_eq_def forces_mem_def
using def_frc_at[of p 1 t1 t2]
unfolding bool_of_o_def
by auto

lemma forces_eq_abs :
"⟦p∈M ; t1∈M ; t2∈M⟧ ⟹ is_forces_eq(p,t1,t2) ⟷ p forces⇩a (t1 = t2)"
unfolding forces_eq_def
using forces_eq'_abs by simp

lemma forces_mem_abs :
"⟦p∈M ; t1∈M ; t2∈M⟧ ⟹ is_forces_mem(p,t1,t2) ⟷ p forces⇩a (t1 ∈ t2)"
unfolding forces_mem_def
using forces_mem'_abs
by simp

definition
forces_neq :: "[i,i,i] ⇒ o" (‹_ forces⇩a '(_ ≠ _')› [36,1,1] 60) where
"p forces⇩a (t1 ≠ t2) ≡ ¬ (∃q∈ℙ. q≼p ∧ q forces⇩a (t1 = t2))"

definition
forces_nmem :: "[i,i,i] ⇒ o" (‹_ forces⇩a '(_ ∉ _')› [36,1,1] 60) where
"p forces⇩a (t1 ∉ t2) ≡ ¬ (∃q∈ℙ. q≼p ∧ q forces⇩a (t1 ∈ t2))"

lemma forces_neq :
"p forces⇩a (t1 ≠ t2) ⟷ forces_neq'(ℙ,leq,p,t1,t2)"
unfolding forces_neq_def forces_neq'_def forces_eq_def by simp

lemma forces_nmem :
"p forces⇩a (t1 ∉ t2) ⟷ forces_nmem'(ℙ,leq,p,t1,t2)"
unfolding forces_nmem_def forces_nmem'_def forces_mem_def by simp

abbreviation Forces :: "[i, i, i] ⇒ o"  ("_ ⊩ _ _" [36,36,36] 60) where
"p ⊩ φ env   ≡   M, ([p,ℙ,leq,𝟭] @ env) ⊨ forces(φ)"

lemma sats_forces_Member :
assumes  "x∈nat" "y∈nat" "env∈list(M)"
"nth(x,env)=xx" "nth(y,env)=yy" "q∈M"
shows "q ⊩ ⋅x ∈ y⋅ env ⟷ q ∈ ℙ ∧ is_forces_mem(q, xx, yy)"
unfolding forces_def
using assms
by simp

lemma sats_forces_Equal :
assumes "a∈nat" "b∈nat" "env∈list(M)" "nth(a,env)=x" "nth(b,env)=y" "q∈M"
shows "q ⊩ ⋅a = b⋅ env ⟷ q ∈ ℙ ∧ is_forces_eq(q, x, y)"
unfolding forces_def
using assms
by simp

lemma sats_forces_Nand :
assumes "φ∈formula" "ψ∈formula" "env∈list(M)" "p∈M"
shows "p ⊩ ⋅¬(φ ∧ ψ)⋅ env ⟷
p∈ℙ ∧ ¬(∃q∈M. q∈ℙ ∧ is_leq(##M,leq,q,p) ∧ (q ⊩ φ env) ∧ (q ⊩ ψ env))"
unfolding forces_def
using sats_is_leq_fm_auto assms sats_ren_forces_nand zero_in_M
by simp

lemma sats_forces_Neg :
assumes "φ∈formula" "env∈list(M)" "p∈M"
shows "p ⊩ ⋅¬φ⋅ env ⟷
(p∈ℙ ∧ ¬(∃q∈M. q∈ℙ ∧ is_leq(##M,leq,q,p) ∧ (q ⊩ φ env)))"
unfolding Neg_def using assms sats_forces_Nand
by simp

lemma sats_forces_Forall :
assumes "φ∈formula" "env∈list(M)" "p∈M"
shows "p ⊩ (⋅∀φ⋅) env ⟷ p ∈ ℙ ∧ (∀x∈M. p ⊩ φ ([x] @ env))"
unfolding forces_def using assms sats_ren_forces_forall
by simp

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

end```