Theory DCR3_Method
subsection ‹Completeness of the DCR3 method for proving confluence of relations of the least uncountable cardinality›
theory DCR3_Method
imports
"HOL-Cardinals.Cardinals"
"Abstract-Rewriting.Abstract_Rewriting"
Finite_DCR_Hierarchy
begin
subsubsection ‹Auxiliary definitions›
abbreviation ω_ord where "ω_ord ≡ natLeq"
definition sc_ord::"'U rel ⇒ 'U rel ⇒ bool"
where "sc_ord α α' ≡ (α <o α' ∧ (∀ β::'U rel. α <o β ⟶ α' ≤o β))"
definition lm_ord::"'U rel ⇒ bool"
where "lm_ord α ≡ Well_order α ∧ ¬ (α = {} ∨ isSuccOrd α)"
definition nord :: "'U rel ⇒ 'U rel" where "nord α = (SOME α'::'U rel. α' =o α)"
definition 𝒪::"'U rel set" where "𝒪 ≡ nord ` {α. Well_order α}"
definition oord::"'U rel rel" where "oord ≡ (Restr ordLeq 𝒪)"
definition CCR :: "'U rel ⇒ bool"
where
"CCR r = (∀a ∈ Field r. ∀b ∈ Field r. ∃c ∈ Field r. (a,c) ∈ r^* ∧ (b,c) ∈ r^*)"
definition Conelike :: "'U rel ⇒ bool"
where
"Conelike r = (r = {} ∨ (∃ m ∈ Field r. ∀ a ∈ Field r. (a,m) ∈ r^*))"
definition dncl :: "'U rel ⇒ 'U set ⇒ 'U set"
where
"dncl r A = ((r^*)^-1)``A"
definition Inv :: "'U rel ⇒ 'U set set"
where
"Inv r = { A :: 'U set . r `` A ⊆ A }"
definition SF :: "'U rel ⇒ 'U set set"
where
"SF r = { A :: 'U set. Field (Restr r A) = A }"
definition SCF::"'U rel ⇒ ('U set) set" where
"SCF r ≡ { B::('U set) . B ⊆ Field r ∧ (∀ a ∈ Field r. ∃ b ∈ B. (a,b) ∈ r^*) }"
definition cfseq :: "'U rel ⇒ (nat ⇒ 'U) ⇒ bool"
where
"cfseq r xi ≡ ((∀ a ∈ Field r. ∃ i. (a, xi i) ∈ r^*) ∧ (∀ i. (xi i, xi (Suc i)) ∈ r))"
definition rpth :: "'U rel ⇒ 'U ⇒ 'U ⇒ nat ⇒ (nat ⇒ 'U) set"
where
"rpth r a b n ≡ { f::(nat ⇒ 'U). f 0 = a ∧ f n = b ∧ (∀i<n. (f i, f(Suc i)) ∈ r) }"
definition ℱ :: "'U rel ⇒ 'U ⇒ 'U ⇒ 'U set set"
where
"ℱ r a b ≡ { F::'U set. ∃ n::nat. ∃ f ∈ rpth r a b n. F = f`{i. i≤n} }"
definition 𝔣 :: "'U rel ⇒ 'U ⇒ 'U ⇒ 'U set"
where
"𝔣 r a b ≡ (if (ℱ r a b ≠ {}) then (SOME F. F ∈ ℱ r a b) else {})"
definition dnEsc :: "'U rel ⇒ 'U set ⇒ 'U ⇒ 'U set set"
where
"dnEsc r A a ≡ { F. ∃ b. ((b ∉ dncl r A) ∧ (F ∈ ℱ r a b) ∧ (F ∩ A = {})) }"
definition dnesc :: "'U rel ⇒ 'U set ⇒ 'U ⇒ 'U set"
where
"dnesc r A a = (if (dnEsc r A a ≠ {}) then (SOME F. F ∈ dnEsc r A a) else { a })"
definition escl :: "'U rel ⇒ 'U set ⇒ 'U set ⇒ 'U set"
where
"escl r A B = ⋃ ((dnesc r A) ` B)"
definition clterm where "clterm s' r ≡ (Conelike s' ⟶ Conelike r)"
definition spthlen::"'U rel ⇒ 'U ⇒ 'U ⇒ nat"
where
"spthlen r a b ≡ (LEAST n::nat. (a,b) ∈ r^^n)"
definition spth :: "'U rel ⇒ 'U ⇒ 'U ⇒ (nat ⇒ 'U) set"
where
"spth r a b = rpth r a b (spthlen r a b)"
definition 𝔘::"'U rel ⇒ ('U rel) set" where
"𝔘 r ≡ { s::('U rel) . CCR s ∧ s ⊆ r ∧ (∀ a ∈ Field r. ∃ b ∈ Field s. (a,b) ∈ r^*) }"
definition RCC_rel :: "'U rel ⇒ 'U rel ⇒ bool" where
"RCC_rel r α ≡ (𝔘 r = {} ∧ α = {}) ∨ (∃ s ∈ 𝔘 r. |s| =o α ∧ ( ∀ s' ∈ 𝔘 r. |s| ≤o |s'| ))"
definition RCC :: "'U rel ⇒ 'U rel" ("∥_∥")
where "∥r∥ ≡ (SOME α. RCC_rel r α)"
definition Den::"'U rel ⇒ ('U set) set" where
"Den r ≡ { B::('U set) . B ⊆ Field r ∧ (∀ a ∈ Field r. ∃ b ∈ B. (a,b) ∈ r^=) }"
definition Span::"'U rel ⇒ ('U rel) set" where
"Span r ≡ { s. s ⊆ r ∧ Field s = Field r }"
definition scf_rel :: "'U rel ⇒ 'U rel ⇒ bool" where
"scf_rel r α ≡ (∃ B ∈ SCF r. |B| =o α ∧ ( ∀ B' ∈ SCF r. |B| ≤o |B'| ))"
definition scf :: "'U rel ⇒ 'U rel"
where "scf r ≡ (SOME α. scf_rel r α)"
definition w_dncl :: "'U rel ⇒ 'U set ⇒ 'U set"
where
"w_dncl r A = { a ∈ dncl r A. ∀ b. ∀ F ∈ ℱ r a b. ( b ∉ dncl r A ⟶ F ∩ A ≠ {} ) }"
definition 𝔏 :: "('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U set"
where
"𝔏 f α ≡ ⋃ {A. ∃ α'. α' <o α ∧ A = f α'}"
definition Dbk :: "('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U set" (" ∇ _ _ ")
where
"∇ f α ≡ f α - (𝔏 f α)"
definition 𝒬 :: "'U rel ⇒ ('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U set"
where
"𝒬 r f α ≡ (f α - (dncl r (𝔏 f α)))"
definition 𝒲 :: "'U rel ⇒ ('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U set"
where
"𝒲 r f α ≡ (f α - (w_dncl r (𝔏 f α)))"
definition 𝒩1 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩1 r α0 ≡ { f . ∀α α'. ( α ≤o α0 ∧ α' ≤o α ) ⟶ (f α') ⊆ (f α) }"
definition 𝒩2:: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩2 r α0 ≡ { f . ∀α. ( α ≤o α0 ∧ ¬ (α = {} ∨ isSuccOrd α) ) ⟶ (∇ f α) = {} }"
definition 𝒩3:: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩3 r α0 ≡ { f . ∀α. ( α ≤o α0 ∧ (α = {} ∨ isSuccOrd α) ) ⟶
( ω_ord ≤o |𝔏 f α| ⟶ ((escl r (𝔏 f α) (f α) ⊆ (f α)) ∧ (clterm (Restr r (f α)) r)) ) }"
definition 𝒩4:: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩4 r α0 ≡ { f . ∀α. ( α ≤o α0 ∧ (α = {} ∨ isSuccOrd α) ) ⟶
( ∀a ∈ (𝔏 f α). ( r``{a} ⊆ w_dncl r (𝔏 f α) ) ∨ ( r``{a} ∩ (𝒲 r f α)≠{} ) ) }"
definition 𝒩5 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩5 r α0 ≡ { f . ∀α. α ≤o α0 ⟶ (f α) ∈ SF r }"
definition 𝒩6 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩6 r α0 ≡ { f. ∀α. α ≤o α0 ⟶ CCR (Restr r (f α)) }"
definition 𝒩7 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩7 r α0 ≡ { f. ∀α. α ≤o α0 ⟶ ( α <o ω_ord ⟶ |f α| <o ω_ord ) ∧ (ω_ord ≤o α ⟶ |f α| ≤o α) }"
definition 𝒩8 :: "'U rel ⇒ 'U set set ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩8 r Ps α0 ≡ { f. ∀α. α ≤o α0 ∧ (α = {} ∨ isSuccOrd α) ∧ ( (∃ P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α| )) ⟶
(∀ P ∈ Ps. ((f α) ∩ P) ∈ SCF (Restr r (f α))) }"
definition 𝒩9 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩9 r α0 ≡ { f . ω_ord ≤o α0 ⟶ Field r ⊆ (f α0) }"
definition 𝒩10 :: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩10 r α0 ≡ { f . ∀α. α ≤o α0 ⟶ ((∃ y::'U. 𝒬 r f α = {y}) ⟶ (Field r ⊆ dncl r (f α))) }"
definition 𝒩11:: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩11 r α0 ≡ { f . ∀α. ( α ≤o α0 ∧ isSuccOrd α) ⟶ 𝒬 r f α = {} ⟶ (Field r ⊆ dncl r (f α)) }"
definition 𝒩12:: "'U rel ⇒ 'U rel ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩12 r α0 ≡ { f . ∀α. α ≤o α0 ⟶ ω_ord ≤o α ⟶ ω_ord ≤o |𝔏 f α| }"
definition 𝒩 :: "'U rel ⇒ 'U set set ⇒ ('U rel ⇒ 'U set) set"
where
"𝒩 r Ps ≡ { f ∈ (𝒩1 r |Field r| ) ∩ (𝒩2 r |Field r| ) ∩ (𝒩3 r |Field r| ) ∩ (𝒩4 r |Field r| )
∩ (𝒩5 r |Field r| ) ∩ (𝒩6 r |Field r| ) ∩ (𝒩7 r |Field r| ) ∩ (𝒩8 r Ps |Field r| )
∩ (𝒩9 r |Field r| ∩ 𝒩10 r |Field r| ∩ 𝒩11 r |Field r| ∩ 𝒩12 r |Field r| ).
(∀ α β. α =o β ⟶ f α = f β) }"
definition 𝒯 :: "('U rel ⇒ 'U set ⇒ 'U set) ⇒ ('U rel ⇒ 'U set) set"
where
"𝒯 F ≡ { f::'U rel ⇒ 'U set .
f {} = {}
∧ (∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0)))
∧ (∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }))
∧ (∀α β. α =o β ⟶ f α = f β) }"
definition ℰp where "ℰp r Ps A A' ≡
(((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| ))
⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A') ))"
definition ℰ :: "'U rel ⇒ 'U ⇒ 'U set ⇒ 'U set set ⇒ 'U set set"
where
"ℰ r a A Ps ≡ { A'.
(a ∈ Field r ⟶ a ∈ A') ∧ A ⊆ A'
∧ ( |A| <o ω_ord ⟶ |A'| <o ω_ord ) ∧ ( ω_ord ≤o |A| ⟶ |A'| ≤o |A| )
∧ (A ∈ SF r ⟶ (
A' ∈ SF r
∧ CCR (Restr r A')
∧ ( ∀ a∈A. (r``{a} ⊆ w_dncl r A) ∨ (r``{a} ∩ (A'-w_dncl r A) ≠ {}) )
∧ ((∃ y. A' - dncl r A ⊆ {y}) ⟶ (Field r ⊆ (dncl r A')))
∧ ℰp r Ps A A'
∧ ( ω_ord ≤o |A| ⟶ escl r A A' ⊆ A' ∧ clterm (Restr r A') r)) ) }"
definition wbase::"'U rel ⇒ 'U set ⇒ ('U set) set" where
"wbase r A ≡ { B::'U set. A ⊆ w_dncl r B }"
definition wrank_rel :: "'U rel ⇒ 'U set ⇒ 'U rel ⇒ bool" where
"wrank_rel r A α ≡ (∃ B ∈ wbase r A. |B| =o α ∧ ( ∀ B' ∈ wbase r A. |B| ≤o |B'| ))"
definition wrank :: "'U rel ⇒ 'U set ⇒ 'U rel"
where "wrank r A ≡ (SOME α. wrank_rel r A α)"
definition Mwn :: "'U rel ⇒ 'U rel ⇒ 'U set"
where
"Mwn r α = { a ∈ Field r. α <o wrank r (r ``{a}) }"
definition Mwnm :: "'U rel ⇒ 'U set"
where
"Mwnm r = { a ∈ Field r. ∥r∥ ≤o wrank r (r ``{a}) }"
definition wesc_rel :: "'U rel ⇒ ('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U ⇒ 'U ⇒ bool"
where
"wesc_rel r f α a b ≡ ( b ∈ 𝒲 r f α ∧ (a,b) ∈ (Restr r (𝒲 r f α))^*
∧ (∀β. α <o β ∧ β <o |Field r| ∧ (β = {} ∨ isSuccOrd β) ⟶ (r``{b} ∩ (𝒲 r f β) ≠ {})) )"
definition wesc :: "'U rel ⇒ ('U rel ⇒ 'U set) ⇒ 'U rel ⇒ 'U ⇒ 'U"
where
"wesc r f α a ≡ (SOME b. wesc_rel r f α a b)"
definition cardLeN1::"'a set ⇒ bool"
where
"cardLeN1 A ≡ (∀ B ⊆ A.
( ∀ C ⊆ B . ((∃ D f. D ⊂ C ∧ C ⊆ f`D ) ⟶ ( ∃ f. B ⊆ f`C )) )
∨ ( ∃ g . A ⊆ g`B ) )"
subsubsection ‹Auxiliary lemmas›
lemma lem_Ldo_ldogen_ord:
assumes "∀α β a b c. α ≤ β ⟶ (a, b) ∈ g α ∧ (a, c) ∈ g β ⟶
(∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α)"
shows "DCR_generating g"
using assms unfolding DCR_generating_def by (meson linear)
lemma lem_rtr_field: "(x,y) ∈ r^* ⟹ (x = y) ∨ (x ∈ Field r ∧ y ∈ Field r)"
by (metis Field_def Not_Domain_rtrancl Range.RangeI UnCI rtranclE)
lemma lem_fin_fl_rel: "finite (Field r) = finite r"
using finite_Field finite_subset trancl_subset_Field2 by fastforce
lemma lem_Relprop_fld_sat:
fixes r s::"'U rel"
assumes a1: "s ⊆ r" and a2: "s' = Restr r (Field s)"
shows "s ⊆ s' ∧ Field s' = Field s"
proof -
have "s ⊆ (Field s) × (Field s)" unfolding Field_def by force
then have "s ⊆ s'" using a1 a2 by blast
moreover then have "Field s ⊆ Field s'" unfolding Field_def by blast
moreover have "Field s' ⊆ Field s" using a2 unfolding Field_def by blast
ultimately show ?thesis by blast
qed
lemma lem_Relprop_sat_un:
fixes r::"'U rel" and S::"'U set set" and A'::"'U set"
assumes a1: "∀A∈S. Field (Restr r A) = A" and a2: "A' = ⋃ S"
shows "Field (Restr r A') = A'"
proof
show "Field (Restr r A') ⊆ A'" unfolding Field_def by blast
next
show "A' ⊆ Field (Restr r A')"
proof
fix x
assume "x ∈ A'"
then obtain A where "A ∈ S ∧ x ∈ A" using a2 by blast
then have "x ∈ Field (Restr r A) ∧ A ⊆ A'" using a1 a2 by blast
moreover then have "Field (Restr r A) ⊆ Field (Restr r A')" unfolding Field_def by blast
ultimately show "x ∈ Field (Restr r A')" by blast
qed
qed
lemma lem_nord_r: "Well_order α ⟹ nord α =o α" unfolding nord_def by (meson ordIso_reflexive someI_ex)
lemma lem_nord_l: "Well_order α ⟹ α =o nord α" unfolding nord_def by (meson ordIso_reflexive ordIso_symmetric someI_ex)
lemma lem_nord_eq: "α =o β ⟹ nord α = nord β" unfolding nord_def using ordIso_symmetric ordIso_transitive by metis
lemma lem_nord_req: "Well_order α ⟹ Well_order β ⟹ nord α = nord β ⟹ α =o β"
using lem_nord_l lem_nord_r ordIso_transitive by metis
lemma lem_Onord: "α ∈ 𝒪 ⟹ α = nord α" unfolding 𝒪_def using lem_nord_r lem_nord_eq by blast
lemma lem_Oeq: "α ∈ 𝒪 ⟹ β ∈ 𝒪 ⟹ α =o β ⟹ α = β" using lem_Onord lem_nord_eq by metis
lemma lem_Owo: "α ∈ 𝒪 ⟹ Well_order α" unfolding 𝒪_def using lem_nord_r ordIso_Well_order_simp by blast
lemma lem_fld_oord: "Field oord = 𝒪" using lem_Owo ordLeq_reflexive unfolding oord_def Field_def by blast
lemma lem_nord_less: "α <o β ⟹ nord β ≠ nord α ∧ (nord α, nord β) ∈ oord"
proof -
assume b1: "α <o β"
then have "nord α ∈ 𝒪 ∧ nord β ∈ 𝒪 ∧ nord α =o α ∧ nord β =o β"
using lem_nord_r ordLess_Well_order_simp unfolding 𝒪_def by blast
moreover have "∀ r A a b. (a,b) ∈ Restr r A = (a ∈ A ∧ b ∈ A ∧ (a,b) ∈ r)"
unfolding Field_def by force
ultimately show "nord β ≠ nord α ∧(nord α, nord β) ∈ oord" using b1 unfolding oord_def
by (metis not_ordLess_ordIso ordIso_iff_ordLeq ordLeq_iff_ordLess_or_ordIso ordLeq_transitive)
qed
lemma lem_nord_ls: "α <o β ⟹ nord α <o nord β"
proof -
assume a1: "α <o β"
then have "Well_order α ∧ Well_order β" unfolding ordLess_def by blast
then have "nord α =o α" and "nord β =o β" using lem_nord_r by blast+
then show "nord α <o nord β" using a1
using ordIso_iff_ordLeq ordIso_ordLess_trans ordLess_ordLeq_trans by blast
qed
lemma lem_nord_le: "α ≤o β ⟹ nord α ≤o nord β"
proof -
assume a1: "α ≤o β"
then have "Well_order α ∧ Well_order β" unfolding ordLeq_def by blast
then have "nord α =o α" and "nord β =o β" using lem_nord_r by blast+
then show "nord α ≤o nord β" using a1 by (meson ordIso_iff_ordLeq ordLeq_transitive)
qed
lemma lem_nordO_ls_l: "α <o β ⟹ nord α ∈ 𝒪" using 𝒪_def ordLess_Well_order_simp by blast
lemma lem_nordO_ls_r: "α <o β ⟹ nord β ∈ 𝒪" using 𝒪_def ordLess_Well_order_simp by blast
lemma lem_nordO_le_l: "α ≤o β ⟹ nord α ∈ 𝒪" using 𝒪_def ordLeq_Well_order_simp by blast
lemma lem_nordO_le_r: "α ≤o β ⟹ nord β ∈ 𝒪" using 𝒪_def ordLeq_Well_order_simp by blast
lemma lem_nord_ls_r: "α <o β ⟹ α <o nord β"
using lem_nord_ls[of α β] lem_nord_r[of β] lem_nord_l by (metis ordLess_ordIso_trans ordLess_Well_order_simp)
lemma lem_nord_ls_l: "α <o β ⟹ nord α <o β"
using lem_nord_ls[of α β] lem_nord_r[of β] by (metis ordLess_ordIso_trans ordLess_Well_order_simp)
lemma lem_nord_le_r: "α ≤o β ⟹ α ≤o nord β"
using lem_nord_le[of α β] lem_nord_r[of β] lem_nord_l by (metis ordLeq_ordIso_trans ordLeq_Well_order_simp)
lemma lem_nord_le_l: "α ≤o β ⟹ nord α ≤o β"
using lem_nord_le[of α β] lem_nord_r[of β] by (metis ordLeq_ordIso_trans ordLeq_Well_order_simp)
lemma lem_oord_wo: "Well_order oord"
proof -
let ?oleqO = "Restr ordLeq 𝒪"
have "Well_order ?oleqO"
proof -
have c1: "Field ordLeq = {α::'U rel. Well_order α}"
using ordLeq_Well_order_simp ordLeq_reflexive unfolding Field_def by blast
then have "Refl ordLeq" using ordLeq_refl_on by metis
then have "Preorder ordLeq" using ordLeq_trans unfolding preorder_on_def by blast
then have "Preorder ?oleqO" using Preorder_Restr by blast
moreover have "∀α β::'U rel. (α, β) ∈ ?oleqO ⟶ (β, α) ∈ ?oleqO ⟶ α = β"
proof (intro allI impI)
fix α β::"'U rel"
assume d1: "(α, β) ∈ ?oleqO" and d2: "(β, α) ∈ ?oleqO"
then have "α ≤o β ∧ β ≤o α" by blast
then have "α =o β" using ordIso_iff_ordLeq by blast
moreover have "α ∈ 𝒪 ∧ β ∈ 𝒪" using d1 by blast
ultimately show "α = β" using lem_Oeq by blast
qed
moreover have "∀ α ∈ Field (?oleqO::'U rel rel). ∀ β ∈ Field ?oleqO. α ≠ β ⟶
(α, β) ∈ ?oleqO ∨ (β, α) ∈ ?oleqO"
proof (intro ballI impI)
fix α β::"'U rel"
assume d1: "α ∈ Field ?oleqO" and d2: "β ∈ Field ?oleqO" and "α ≠ β"
then have "Well_order α ∧ Well_order β" using c1 unfolding Field_def
by (metis (no_types, lifting) Field_Un Field_def Un_def mem_Collect_eq sup_inf_absorb)
then have "α ≤o β ∨ β ≤o α" using ordLess_imp_ordLeq ordLess_or_ordLeq by blast
moreover have "α ∈ 𝒪 ∧ β ∈ 𝒪" using d1 d2 unfolding Field_def by blast
ultimately show "(α, β) ∈ ?oleqO ∨ (β, α) ∈ ?oleqO" by blast
qed
ultimately have "Linear_order ?oleqO" unfolding linear_order_on_def
partial_order_on_def total_on_def antisym_def preorder_on_def by blast
moreover have "wf ((?oleqO::'U rel rel) - Id)"
proof -
have "Restr (ordLess::'U rel rel) 𝒪 ⊆ ?oleqO - Id"
using not_ordLeq_ordLess ordLeq_iff_ordLess_or_ordIso by blast
moreover have "(?oleqO::'U rel rel) - Id ⊆ Restr ordLess 𝒪"
using lem_Oeq ordLeq_iff_ordLess_or_ordIso by blast
ultimately have "(?oleqO::'U rel rel) - Id = Restr ordLess 𝒪" by blast
moreover have "wf (Restr ordLess 𝒪)"
using wf_ordLess Restr_subset wf_subset[of ordLess "Restr ordLess 𝒪"] by blast
ultimately show ?thesis by simp
qed
ultimately show ?thesis unfolding well_order_on_def by blast
qed
moreover have "Well_order |(UNIV - 𝒪)::'U rel set|" using card_of_Well_order by blast
moreover have "Field (Restr ordLeq 𝒪) ∩ Field ( |(UNIV - 𝒪)::'U rel set| ) = {}"
proof -
have "Field (Restr ordLeq 𝒪) ⊆ 𝒪" unfolding Field_def by blast
moreover have "Field ( |(UNIV - 𝒪)::'U rel set| ) ⊆ UNIV - 𝒪" by simp
ultimately show ?thesis by blast
qed
ultimately show ?thesis unfolding oord_def using Osum_Well_order by blast
qed
lemma lem_lmord_inf:
fixes α::"'U rel"
assumes "lm_ord α"
shows "¬ finite (Field α)"
proof -
have "finite (Field α) ⟶ False"
proof
assume c1: "finite (Field α)"
have c2: "Well_order α" using assms unfolding lm_ord_def by blast
have "α ≠ {}" using assms lm_ord_def by blast
then have "Field α ≠ {}" unfolding Field_def by force
then have "wo_rel.isMaxim α (Field α) (wo_rel.maxim α (Field α))"
using c1 c2 wo_rel.maxim_isMaxim[of α "Field α"] unfolding wo_rel_def by blast
then have "∃j∈Field α. ∀i∈Field α. (i, j) ∈ α"
using c2 wo_rel.isMaxim_def[of α "Field α"] unfolding wo_rel_def by blast
then have "isSuccOrd α" using c2 wo_rel.isSuccOrd_def unfolding wo_rel_def by blast
then show "False" using assms unfolding lm_ord_def by blast
qed
then show ?thesis by blast
qed
lemma lem_sucord_ex:
fixes α β::"'U rel"
assumes "α <o β"
shows "∃ α'::'U rel. sc_ord α α'"
proof -
obtain S::"'U rel set" where b1: "S = { γ::'U rel. α <o γ }" by blast
then have "S ≠ {} ∧ (∀ α ∈ S. Well_order α)" using assms ordLess_Well_order_simp by blast
then obtain α' where "α' ∈ S ∧ (∀α ∈ S. α' ≤o α)"
using BNF_Wellorder_Constructions.exists_minim_Well_order[of S] by blast
then show ?thesis unfolding b1 sc_ord_def by blast
qed
lemma lem_osucc_eq: "isSuccOrd α ⟹ α =o β ⟹ isSuccOrd β"
proof -
assume a1: "isSuccOrd α" and a2: "α =o β"
moreover then have a3: "wo_rel α" and a4: "wo_rel β" unfolding ordIso_def wo_rel_def by blast+
obtain j where a5: "j ∈ Field α" and a6: "∀i∈Field α. (i, j) ∈ α" using a1 a3 wo_rel.isSuccOrd_def by blast
obtain f where a7: "iso α β f" using a2 unfolding ordIso_def by blast
have "(f j) ∈ Field β" using a5 a7 unfolding iso_def bij_betw_def by blast
moreover have "∀ i' ∈ Field β. (i', f j) ∈ β"
proof
fix i'
assume b1: "i' ∈ Field β"
then obtain i where b2: "i ∈ Field α ∧ i' = f i" using a7 unfolding iso_def bij_betw_def by blast
then have "(i, j) ∈ α" using a6 by blast
then have "(f i, f j) ∈ β" using a2 a7 by (meson iso_oproj oproj_in ordIso_Well_order_simp)
then show "(i', f j) ∈ β" using b2 by blast
qed
ultimately have "∃j∈Field β. ∀i∈Field β. (i, j) ∈ β" by blast
then show "isSuccOrd β" using a4 wo_rel.isSuccOrd_def by blast
qed
lemma lem_ord_subemp: "(α::'a rel) ≤o ({}::'b rel) ⟹ α = {}"
proof -
assume "α ≤o ({}::'b rel)"
then obtain f where "embed α ({}::'b rel) f" unfolding ordLeq_def by blast
then show "α = {}" unfolding embed_def bij_betw_def Field_def under_def by force
qed
lemma lem_ordint_sucord:
fixes α0::"'a rel" and α::"'b rel"
assumes "α0 <o α ∧ (∀ γ::'b rel. α0 <o γ ⟶ α ≤o γ)"
shows "isSuccOrd α"
proof -
have c1: "Well_order α" using assms unfolding ordLess_def by blast
obtain f where e3: "Well_order α0 ∧ Well_order α ∧ embedS α0 α f" using assms unfolding ordLess_def by blast
moreover have e4: "f ` Field α0 ⊆ Field α" using e3 embed_in_Field[of α0 α f] unfolding embedS_def by blast
have "f ` Field α0 ≠ Field α" using e3 embed_inj_on unfolding bij_betw_def embedS_def by blast
then obtain j0 where e5: "j0 ∈ Field α ∧ j0 ∉ f ` Field α0" using e4 by blast
moreover have "∀ i ∈ Field α. (i, j0) ∈ α"
proof
fix i
assume "i ∈ Field α"
moreover then have "(i, i) ∈ α" using e3 unfolding well_order_on_def
linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by blast
moreover have "(j0, i) ∈ α ⟶ (i, j0) ∈ α"
proof
assume g1: "(j0, i) ∈ α"
obtain γ where g2: "γ = Restr α (under α j0)" by blast
then have g3: "Well_order γ" using e3 Well_order_Restr by blast
have "α0 <o γ"
proof -
have h1: "∀ a ∈ Field α0. f a ∈ under α j0"
proof
fix a
assume i1: "a ∈ Field α0"
then have i2: "bij_betw f (under α0 a) (under α (f a))" using e3 unfolding embedS_def embed_def by blast
have "(j0, f a) ∈ α ⟶ False"
proof
assume "(j0, f a) ∈ α"
then obtain b where "j0 = f b ∧ b ∈ under α0 a" using i2 unfolding under_def bij_betw_def by (simp, blast)
moreover then have "b ∈ Field α0" unfolding under_def Field_def by blast
ultimately show "False" using e5 by blast
qed
moreover have i3: "j0 ∈ Field α" using g1 unfolding Field_def by blast
moreover have "f a ∈ Field α" using i1 e3 embed_Field unfolding embedS_def by blast
ultimately have i4: "(f a, j0) ∈ α"
using e3 unfolding well_order_on_def linear_order_on_def total_on_def
partial_order_on_def preorder_on_def refl_on_def by metis
then show "f a ∈ under α j0" unfolding under_def by blast
qed
then have "compat α0 γ f"
using e3 g2 embed_compat unfolding Field_def embedS_def compat_def by blast
moreover have "ofilter γ (f ` Field α0)"
proof -
have "ofilter α (under α j0)" using e3 wo_rel.under_ofilter[of α] unfolding wo_rel_def by blast
moreover have "ofilter α (f ` Field α0)"
using e3 embed_iff_compat_inj_on_ofilter[of α0 α f] unfolding embedS_def by blast
moreover have "f ` Field α0 ⊆ under α j0" using h1 by blast
ultimately show "ofilter γ (f ` Field α0)"
using g2 e3 ofilter_Restr_subset[of α "f ` Field α0" "under α j0"] by blast
qed
moreover have "inj_on f (Field α0)"
using e3 embed_iff_compat_inj_on_ofilter[of α0 α f] unfolding embedS_def by blast
ultimately have "embed α0 γ f" using g3 e3 embed_iff_compat_inj_on_ofilter[of α0 γ f] by blast
moreover have "bij_betw f (Field α0) (Field γ) ⟶ False"
proof
assume i1: "bij_betw f (Field α0) (Field γ)"
have "(j0, j0) ∈ α" using e3 e5 unfolding well_order_on_def
linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by blast
then have "j0 ∈ Field γ" using g2 unfolding under_def Field_def by blast
then show "False" using i1 e5 unfolding bij_betw_def by blast
qed
ultimately have "embedS α0 γ f" unfolding embedS_def by blast
then show ?thesis using g3 e3 unfolding ordLess_def by blast
qed
then have "α =o γ" using assms g2 e3 under_Restr_ordLeq[of α j0] ordIso_iff_ordLeq by blast
then obtain f1 where "iso α γ f1" unfolding ordIso_def by blast
then have g4: "embed α γ f1 ∧ bij_betw f1 (Field α) (Field γ)" unfolding iso_def by blast
then have "f1 ` under α i = under γ (f1 i)" using g1 unfolding bij_betw_def embed_def Field_def by blast
then have "(f1 i, j0) ∈ α" using g1 unfolding g2 under_def by blast
moreover have "f1 i = i"
proof -
have "Restr α (Field α) = α" unfolding Field_def by force
moreover have "ofilter α (under α j0)" using e3 wo_rel.under_ofilter[of α] unfolding wo_rel_def by blast
moreover have "ofilter α (Field α)" unfolding ofilter_def under_def Field_def by blast
moreover have "under α j0 ⊆ Field α" unfolding under_def Field_def by blast
ultimately have "embed γ α id" using g2 e3 ofilter_subset_embed by metis
then have "embed α α (id ∘ f1)" using g4 e3 comp_embed by blast
then have "embed α α f1" by simp
moreover have "embed α α id" unfolding embed_def id_def bij_betw_def inj_on_def by blast
ultimately have "∀ k ∈ Field α. f1 k = k" using e3 embed_unique[of α α f1 id] unfolding id_def by blast
moreover have "i ∈ Field α" using g1 unfolding Field_def by blast
ultimately show ?thesis by blast
qed
ultimately show "(i, j0) ∈ α" by metis
qed
ultimately show "(i, j0) ∈ α"
using e3 e5 unfolding well_order_on_def linear_order_on_def total_on_def by metis
qed
ultimately show "isSuccOrd α" using c1 wo_rel.isSuccOrd_def[of α] unfolding wo_rel_def by blast
qed
lemma lem_sucord_ordint:
fixes α::"'U rel"
assumes "Well_order α ∧ isSuccOrd α"
shows "∃ α0::'U rel. α0 <o α ∧ (∀ γ::'U rel. α0 <o γ ⟶ α ≤o γ)"
proof -
obtain j where b1: "j ∈ Field α ∧ (∀i ∈ Field α. (i, j) ∈ α)"
using assms wo_rel.isSuccOrd_def unfolding wo_rel_def by blast
moreover obtain α0 where b2: "α0 = Restr α (UNIV - {j})" by blast
moreover have "∀ i. (j, i) ∈ α ⟶ i = j" using assms b1 unfolding Field_def well_order_on_def
linear_order_on_def partial_order_on_def antisym_def by blast
ultimately have b3: "embedS α0 α id"
unfolding Field_def embedS_def embed_def id_def bij_betw_def under_def inj_on_def
apply simp
by blast
moreover have b4: "Well_order α0" using assms b2 Well_order_Restr by blast
ultimately have "α0 <o α" using assms unfolding ordLess_def by blast
moreover have "∀ γ::'U rel. α0 <o γ ⟶ α ≤o γ"
proof (intro allI impI)
fix γ::"'U rel"
assume c1: "α0 <o γ"
then have c2: "Well_order γ" unfolding ordLess_def by blast
obtain f where "embedS α0 γ f" using c1 unfolding ordLess_def by blast
then have c3: "embed α0 γ f ∧ ¬ bij_betw f (Field α0) (Field γ)" unfolding embedS_def by blast
have "γ <o α ⟶ False"
proof
assume d1: "γ <o α"
obtain g where "embedS γ α g" using d1 unfolding ordLess_def by blast
then have d3: "embed γ α g ∧ ¬ bij_betw g (Field γ) (Field α)" unfolding embedS_def by blast
have d4: "j ∈ g ` Field γ ⟶ False"
proof
assume "j ∈ g ` Field γ"
then obtain a where "a ∈ Field γ ∧ g a = j" by blast
then have "bij_betw g (under γ a) (under α j)" using d3 unfolding embed_def by blast
moreover have "under α j = Field α" using b1 unfolding under_def Field_def by blast
ultimately have "bij_betw g (under γ a) (Field α)" by simp
then have "g ` Field γ ≠ Field α ∧ g ` Field γ ⊆ Field α ∧ g ` under γ a = Field α"
using c2 d3 embed_inj_on[of γ α g] embed_Field[of γ α g] unfolding bij_betw_def by blast
moreover have "under γ a ⊆ Field γ" unfolding under_def Field_def by blast
ultimately show "False" by blast
qed
have "Field γ ⊆ f ` Field α0"
proof
fix a
assume e1: "a ∈ Field γ"
then have "bij_betw g (under γ a) (under α (g a))" using d3 unfolding embed_def by blast
have "g a ∈ Field α - {j}" using e1 c2 d3 d4 embed_Field by blast
moreover then have "(g a, g a) ∈ α" using assms unfolding Field_def well_order_on_def
linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by blast
ultimately have e2: "g a ∈ Field α0" using b2 unfolding Field_def by blast
have "embed α0 α (g ∘ f)" using b4 c3 d3 comp_embed[of α0 γ f α g] by blast
then have "∀ x ∈ Field α0. g (f x) = x" using assms b3 b4 embed_unique[of α0 α "g ∘ f" id]
unfolding embedS_def comp_def id_def by blast
then have "g (f (g a)) = g a" using e2 by blast
moreover have "inj_on g (Field γ)" using c2 d3 embed_inj_on[of γ α g] by blast
moreover have "f (g a) ∈ Field γ" using e2 b4 c3 embed_Field[of α0 γ f] by blast
ultimately have "f (g a) = a" using e1 unfolding inj_on_def by blast
then show "a ∈ f ` Field α0" using e2 by force
qed
then have "bij_betw f (Field α0) (Field γ)"
using b4 c3 embed_inj_on[of α0 γ f] embed_Field[of α0 γ f] unfolding bij_betw_def by blast
then show "False" using c3 by blast
qed
then show "α ≤o γ" using assms c2 by simp
qed
ultimately show ?thesis by blast
qed
lemma lem_sclm_ordind:
fixes P::"'U rel ⇒ bool"
assumes a1: "P {}"
and a2: "∀ α0 α::'U rel. (sc_ord α0 α ∧ P α0 ⟶ P α)"
and a3: "∀ α. ((lm_ord α ∧ (∀ β. β <o α ⟶ P β)) ⟶ P α)"
shows "∀ α. Well_order α ⟶ P α"
proof -
obtain Q where b1: "Q = (λ α. Well_order α ⟶ P α)" by blast
have "∀ α. (∀ β. β <o α ⟶ Q β) ⟶ Q α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "∀ β. β <o α ⟶ Q β"
then have c2: "∀ β. β <o α ⟶ P β" unfolding b1 ordLess_def by blast
show "Q α"
proof (cases "∃ α0. sc_ord α0 α")
assume "∃ α0. sc_ord α0 α"
then obtain α0 where "sc_ord α0 α" by blast
then show "Q α" using c2 b1 a2 unfolding sc_ord_def by blast
next
assume "¬ (∃ α0. sc_ord α0 α)"
then have "(¬ Well_order α) ∨ α = {} ∨ lm_ord α"
using lem_sucord_ordint unfolding sc_ord_def lm_ord_def by blast
moreover have "lm_ord α ⟶ P α" using c2 a3 by blast
ultimately show "Q α" using a1 b1 by blast
qed
qed
then show ?thesis using b1 wf_induct[of ordLess Q] wf_ordLess by blast
qed
lemma lem_ordseq_rec_sets:
fixes E::"'U set" and F::"'U rel ⇒ 'U set ⇒ 'U set"
assumes "∀ α β. α =o β ⟶ F α = F β"
shows "∃ f::('U rel ⇒ 'U set).
f {} = E
∧ (∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0)))
∧ (∀ α. lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })
∧ (∀ α β. α =o β ⟶ f α = f β)"
proof -
obtain cmp::"'U rel rel" where b1: "cmp = oord" by blast
then interpret cmp: wo_rel cmp unfolding wo_rel_def using lem_oord_wo by blast
obtain L where b2: "L = (λ g::'U rel ⇒ 'U set. λ α::'U rel. ⋃ (g ` (underS cmp α)))" by blast
then have b3: "adm_woL cmp L" unfolding cmp.adm_woL_def by blast
obtain fo where b4: "fo = (worecZSL cmp E F L)" by blast
obtain f where b5: "f = (λ α::'U rel. fo (nord α))" by blast
have b6: "fo (zero cmp) = E" using b3 b4 cmp.worecZSL_zero by simp
have b7: "∀ α. aboveS cmp α ≠ {} ⟶ fo (succ cmp α) = F α (fo α)"
using b3 b4 cmp.worecZSL_succ by metis
have b8: "∀ α. isLim cmp α ∧ α ≠ zero cmp ⟶ fo α = ⋃ (fo ` (underS cmp α))"
using b2 b3 b4 cmp.worecZSL_isLim by metis
have b9: "zero cmp = {} ∧ nord ({}::'U rel) = {}"
proof -
obtain isz where c1: "isz = (λ α. α ∈ Field cmp ∧ (∀β∈Field cmp. (α, β) ∈ cmp))" by blast
have c2: "{} ∈ (𝒪::'U rel set)"
proof -
have "Well_order ({}::'U rel)" by simp
moreover then have "nord ({}::'U rel) = {}" using lem_nord_r lem_ord_subemp ordIso_iff_ordLeq by blast
ultimately show ?thesis unfolding 𝒪_def by blast
qed
moreover have "∀ β ∈ 𝒪::('U rel set). ({}, β) ∈ oord"
proof
fix β::"'U rel"
assume d1: "β ∈ 𝒪"
then have "Well_order β" using lem_Owo by blast
then have "{} ≤o β" using ozero_ordLeq unfolding ozero_def by blast
then show "({}, β) ∈ oord" using d1 c2 unfolding oord_def by blast
qed
ultimately have "isz {}" using c1 b1 lem_fld_oord by blast
moreover have "∀ α. isz α ⟶ α = {}"
proof (intro allI impI)
fix α
assume d1: "isz α"
then have d2: "α ∈ 𝒪 ∧ (∀ β ∈ 𝒪. (α, β) ∈ oord)" using c1 b1 lem_fld_oord by blast
have "Well_order ({}::'U rel)" by simp
then have "α ≤o nord ({}::'U rel) ∧ nord ({}::'U rel) =o ({}::'U rel)"
using d2 lem_nord_r unfolding oord_def 𝒪_def by blast
then have "α ≤o ({}::'U rel)" using ordLeq_ordIso_trans by blast
then show "α = {}" using lem_ord_subemp by blast
qed
ultimately have "(THE α. isz α) = {}" by (simp only: the_equality)
then have "zero cmp = {}" unfolding c1 cmp.zero_def cmp.minim_def cmp.isMinim_def by blast
moreover have "nord ({}::'U rel) = {}" using c2 lem_Onord by blast
ultimately show ?thesis by blast
qed
have b10: "∀ α α'::'U rel. aboveS cmp α ≠ {} ∧ α' = succ cmp α ⟶ (α ∈ 𝒪 ∧ α' ∈ 𝒪 ∧ α <o α' ∧ (∀ β::'U rel. α <o β ⟶ α' ≤o β))"
proof (intro allI impI)
fix α α'
assume "aboveS cmp α ≠ {} ∧ α' = succ cmp α"
moreover then have "AboveS cmp {α} ⊆ Field cmp ∧ AboveS cmp {α} ≠ {}"
unfolding AboveS_def aboveS_def Field_def by blast
ultimately have c4: "isMinim cmp (AboveS cmp {α}) α'"
using cmp.minim_isMinim unfolding cmp.succ_def cmp.suc_def by blast
have c5: "(α, α') ∈ cmp ∧ α ≠ α'" using c4 lem_fld_oord unfolding cmp.isMinim_def AboveS_def by blast
then have "α ≤o α' ∧ ¬ (α =o α')" using b1 lem_Oeq unfolding oord_def by blast
then have "α <o α'" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "∀ β::'U rel. α <o β ⟶ α' ≤o β"
proof (intro allI impI)
fix β::"'U rel"
assume d1: "α <o β"
have "nord β ≠ nord α ∧ (nord α, nord β) ∈ cmp" using d1 b1 lem_nord_less by blast
moreover then have "nord β ∈ Field cmp" unfolding Field_def by blast
ultimately have "nord β ∈ AboveS cmp {nord α}" unfolding AboveS_def by blast
moreover have "α = nord α" using c5 b1 lem_Onord unfolding oord_def by blast
ultimately have "(α', nord β) ∈ cmp" using c4 unfolding cmp.isMinim_def by metis
then have "α' ≤o nord β" unfolding b1 oord_def by blast
moreover have "nord β =o β" using d1 lem_nord_r ordLess_Well_order_simp by blast
ultimately show "α' ≤o β" using ordLeq_ordIso_trans by blast
qed
moreover have "α ∈ 𝒪 ∧ α' ∈ 𝒪" using c5 b1 unfolding oord_def by blast
ultimately show "α ∈ 𝒪 ∧ α' ∈ 𝒪 ∧ α <o α' ∧ (∀ β::'U rel. α <o β ⟶ α' ≤o β)" by blast
qed
then have b11: "∀ α::'U rel. Well_order α ∧ ¬ (α = {} ∨ isSuccOrd α) ⟶ isLim cmp α"
using lem_ordint_sucord unfolding cmp.isLim_def cmp.isSucc_def by metis
have "f {} = E" using b5 b6 b9 by simp
moreover have "(∀ α α'::'U rel. (α <o α' ∧ (∀ β::'U rel. α <o β ⟶ α' ≤o β) ⟶ f α' = F α (f α)))"
proof (intro allI impI)
fix α α'::"'U rel"
assume c1: "α <o α' ∧ (∀ β::'U rel. α <o β ⟶ α' ≤o β)"
then have c2: "(aboveS cmp (nord α)) ≠ {}" using lem_nord_less unfolding b1 aboveS_def by fast
obtain γ where c3: "γ = succ cmp (nord α)" by blast
have c4: "γ ∈ 𝒪 ∧ (nord α) <o γ ∧ (∀β::'U rel. (nord α) <o β ⟶ γ ≤o β)" using c2 c3 b10 by blast
moreover have "nord α =o α" using c1 lem_nord_r ordLess_Well_order_simp by blast
ultimately have "α <o γ ∧ (∀β::'U rel. α <o β ⟶ γ ≤o β)" using ordIso_iff_ordLeq ordLeq_ordLess_trans by blast
then have "α' =o γ" using c1 ordIso_iff_ordLeq by blast
then have "f α' = f γ" using b5 lem_nord_eq by metis
moreover have "γ = nord γ" using c4 lem_Onord by blast
moreover have "fo γ = F (nord α) (f α)" using c2 c3 b5 b7 by blast
moreover have "F (nord α) (f α) = F α (f α)" using assms c1 lem_nord_r ordLess_Well_order_simp by metis
ultimately show "f α' = F α (f α)" using b5 by metis
qed
moreover have "∀ α. (Well_order α ∧ ¬ (α = {} ∨ isSuccOrd α)) ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "Well_order α ∧ ¬ (α = {} ∨ isSuccOrd α)"
then have "Well_order (nord α)" using lem_nord_l unfolding ordIso_def by blast
moreover have "nord α ≠ {} ∧ ¬ isSuccOrd (nord α)"
using c1 lem_ord_subemp ordIso_iff_ordLeq lem_osucc_eq[of "nord α" α] lem_nord_r[of α] by metis
ultimately have c2: "fo (nord α) = ⋃ (fo ` (underS cmp (nord α)))" using b8 b9 b11 by metis
obtain A where c3: "A = ⋃ { D. ∃ β::'U rel. β <o α ∧ D = f β }" by blast
have "∀ γ ∈ underS cmp (nord α). ∃ β::'U rel. β <o α ∧ fo γ = f β"
proof
fix γ::"'U rel"
assume "γ ∈ underS cmp (nord α)"
then have "γ ≠ nord α ∧ (γ, nord α) ∈ oord" unfolding b1 underS_def by blast
then have "γ ≤o nord α ∧ γ ∈ 𝒪 ∧ ¬ (γ =o nord α)" using lem_Oeq unfolding oord_def by blast
then have "γ <o nord α ∧ γ = nord γ" using lem_Onord ordLeq_iff_ordLess_or_ordIso by blast
moreover have "nord α =o α" using c1 lem_nord_r by blast
ultimately have "γ <o α ∧ fo γ = f γ" unfolding b5 using ordIso_imp_ordLeq ordLess_ordLeq_trans by metis
then show "∃ β::'U rel. β <o α ∧ fo γ = f β" by blast
qed
then have c4: "f α ⊆ A" unfolding c2 c3 b5 by blast
have "∀ β::'U rel. β <o α ⟶ (∃ γ ∈ underS cmp (nord α). f β = fo γ)"
proof (intro allI impI)
fix β::"'U rel"
assume "β <o α"
then have "(nord β, nord α) ∈ cmp ∧ nord β ≠ nord α" using b1 lem_nord_less by blast
then have "nord β ∈ underS cmp (nord α)" unfolding underS_def by blast
then show "∃ γ ∈ underS cmp (nord α). f β = fo γ" unfolding b5 by blast
qed
then have "A ⊆ f α" unfolding c2 c3 b5 by force
then show "f α = ⋃ { D. ∃ β::'U rel. β <o α ∧ D = f β }" using c3 c4 by blast
qed
moreover have "∀ α β. α =o β ⟶ f α = f β" using b5 lem_nord_eq by metis
ultimately show ?thesis unfolding sc_ord_def lm_ord_def by blast
qed
lemma lem_lmord_prec:
fixes α::"'a rel" and α'::"'b rel"
assumes a1: "α' <o α" and a2: "isLimOrd α"
shows "∃ β::('a rel). α' <o β ∧ β <o α"
proof -
have "¬ isSuccOrd α" using a1 a2 wo_rel.isLimOrd_def unfolding ordLess_def wo_rel_def by blast
then obtain β::"'a rel" where "α' <o β ∧ ¬ (α ≤o β)" using a1 lem_ordint_sucord[of α' α] by blast
then have "α' <o β ∧ β <o α" using a1 ordIso_imp_ordLeq ordLess_Well_order_simp
ordLess_imp_ordLeq ordLess_or_ordIso by metis
then show ?thesis by blast
qed
lemma lem_inford_ge_w:
fixes α::"'U rel"
assumes "Well_order α" and "¬ finite (Field α)"
shows "ω_ord ≤o α"
using assms card_of_least infinite_iff_natLeq_ordLeq ordLeq_transitive by blast
lemma lem_ge_w_inford:
fixes α::"'U rel"
assumes "ω_ord ≤o α"
shows "¬ finite (Field α)"
using assms cinfinite_def cinfinite_mono natLeq_cinfinite by blast
lemma lem_fin_card: "finite |A| = finite A"
proof
assume "finite |A|"
then show "finite A" using finite_Field by fastforce
next
assume "finite A"
then show "finite |A|" using lem_fin_fl_rel by fastforce
qed
lemma lem_cardord_emp: "Card_order ({}::'U rel)"
by (metis Well_order_empty card_order_on_def ozero_def ozero_ordLeq well_order_on_Well_order)
lemma lem_card_emprel: "|{}::'U rel| =o ({}::'U rel)"
proof -
have "({}::'U rel) =o |{}::'U set|" using lem_cardord_emp BNF_Cardinal_Order_Relation.card_of_unique by simp
then show ?thesis using card_of_empty_ordIso ordIso_symmetric ordIso_transitive by blast
qed
lemma lem_cord_lin: "Card_order α ⟹ Card_order β ⟹ ( α ≤o β) = ( ¬ ( β <o α ) )" by simp
lemma lem_co_one_ne_min:
fixes α::"'U rel" and a::"'a"
assumes "Well_order α" and "α ≠ {}"
shows "|{a}| ≤o α"
proof -
have "Field α ≠ {}" using assms unfolding Field_def by force
then have "|{a}| ≤o |Field α|" using assms by simp
moreover have "|Field α| ≤o α" using assms card_of_least by blast
ultimately show ?thesis using ordLeq_transitive by blast
qed
lemma lem_rel_inf_fld_card:
fixes r::"'U rel"
assumes "¬ finite r"
shows "|Field r| =o |r|"
proof -
obtain f1::"'U × 'U ⇒ 'U" where b1: "f1 = (λ (x,y). x)" by blast
obtain f2::"'U × 'U ⇒ 'U" where b2: "f2 = (λ (x,y). y)" by blast
then have "f1 ` r = Domain r ∧ f2 ` r = Range r" using b1 b2 by force
then have b3: "|Domain r| ≤o |r| ∧ |Range r| ≤o |r|"
using card_of_image[of f1 r] card_of_image[of f2 r] by simp
have "|Domain r| ≤o |Range r| ∨ |Range r| ≤o |Domain r|" by (simp add: ordLeq_total)
moreover have "|Domain r| ≤o |Range r| ⟶ |Field r| ≤o |r|"
proof
assume c1: "|Domain r| ≤o |Range r|"
moreover have "finite (Domain r) ∧ finite (Range r) ⟶ finite (Field r)" unfolding Field_def by blast
ultimately have "¬ finite (Range r)"
using assms lem_fin_fl_rel card_of_ordLeq_finite by blast
then have "|Field r| =o |Range r|" using c1 card_of_Un_infinite unfolding Field_def by blast
then show "|Field r| ≤o |r|" using b3 ordIso_ordLeq_trans by blast
qed
moreover have "|Range r| ≤o |Domain r| ⟶ |Field r| ≤o |r|"
proof
assume c1: "|Range r| ≤o |Domain r|"
moreover have "finite (Domain r) ∧ finite (Range r) ⟶ finite (Field r)" unfolding Field_def by blast
ultimately have "¬ finite (Domain r)"
using assms lem_fin_fl_rel card_of_ordLeq_finite by blast
then have "|Field r| =o |Domain r|" using c1 card_of_Un_infinite unfolding Field_def by blast
then show "|Field r| ≤o |r|" using b3 ordIso_ordLeq_trans by blast
qed
ultimately have "|Field r| ≤o |r|" by blast
moreover have "|r| ≤o |Field r|"
proof -
have "r ⊆ (Field r) × (Field r)" unfolding Field_def by force
then have c1: "|r| ≤o |Field r × Field r|" by simp
have "¬ finite (Field r)" using assms lem_fin_fl_rel by blast
then have c2: "|Field r × Field r| =o |Field r|" by simp
show ?thesis using c1 c2 using ordLeq_ordIso_trans by blast
qed
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
lemma lem_cardreleq_cardfldeq_inf:
fixes r1 r2:: "'U rel"
assumes a1: "|r1| =o |r2|" and a2: "¬ finite r1 ∨ ¬ finite r2"
shows "|Field r1| =o |Field r2|"
proof -
have "¬ finite r1 ∧ ¬ finite r2" using a1 a2 by simp
then have "|Field r1| =o |r1| ∧ |Field r2| =o |r2|" using lem_rel_inf_fld_card by blast
then show "|Field r1| =o |Field r2|" using a1 by (meson ordIso_symmetric ordIso_transitive)
qed
lemma lem_card_un_bnd:
fixes S::"'a set set" and α::"'U rel"
assumes a3: "∀A∈S. |A| ≤o α" and a4: "|S| ≤o α" and a5: "ω_ord ≤o α"
shows "| ⋃ S | ≤o α"
proof -
obtain α' where b0: "α' = |Field α|" by blast
have a3': "∀A∈S. |A| ≤o α'"
proof
fix A
assume "A ∈ S"
then have "|A| ≤o α" using a3 by blast
moreover have "Card_order |A|" by simp
ultimately show "|A| ≤o α'" using b0 card_of_unique card_of_mono2 ordIso_ordLeq_trans by blast
qed
have "Card_order |S|" by simp
then have a4': "|S| ≤o α'" using b0 a4 card_of_unique card_of_mono2 ordIso_ordLeq_trans by blast
have a5': "¬ finite (Field α')"
proof -
have "Card_order α'" using b0 by simp
then have "|Field α| =o |Field α'|" using b0 card_of_unique by blast
moreover have "¬ finite (Field α)" using a5 lem_ge_w_inford by blast
ultimately show "¬ finite (Field α')" by simp
qed
have a0': "α' ≤o α" using b0 a4 by simp
obtain r where b1: "r = ⋃ S" by blast
have "∀ A ∈ S. |A| ≤o α'" using a3' ordIso_ordLeq_trans by blast
moreover have "r = (⋃A∈S. A)" using b1 by blast
moreover have "Card_order α'" using b0 by simp
ultimately have "|r| ≤o α'" using a4' a5' card_of_UNION_ordLeq_infinite_Field[of α' S "λ x. x"] by blast
then have "| ⋃ S | ≤o α'" unfolding b1 using ordLeq_transitive by blast
then show "| ⋃ S | ≤o α" using a0' ordLeq_transitive by blast
qed
lemma lem_ord_suc_ge_w:
fixes α0 α::"'U rel"
assumes a1: "ω_ord ≤o α" and a2: "sc_ord α0 α"
shows "ω_ord ≤o α0"
proof -
obtain N::"'U set" where b1: "|N| =o ω_ord" using a1
by (metis card_of_nat Field_natLeq card_of_mono2 internalize_card_of_ordLeq ordIso_symmetric ordIso_transitive)
have "α0 <o |N| ⟶ False"
proof
assume c1: "α0 <o |N|"
have "Well_order ω_ord ∧ isLimOrd ω_ord"
by (metis natLeq_Well_order Field_natLeq card_of_nat card_order_infinite_isLimOrd infinite_iff_natLeq_ordLeq natLeq_Card_order ordIso_iff_ordLeq)
then have "¬ isSuccOrd ω_ord" using wo_rel.isLimOrd_def unfolding wo_rel_def by blast
then have "¬ isSuccOrd |N|" using b1 lem_osucc_eq by blast
then have "¬ (∀γ::'U rel. α0 <o γ ⟶ |N| ≤o γ)"
using c1 unfolding sc_ord_def using lem_ordint_sucord[of α0 "|N|"] by blast
then obtain β::"'U rel" where "α0 <o β ∧ β <o |N|"
using card_of_Well_order not_ordLeq_iff_ordLess ordLess_Well_order_simp by blast
moreover then have "α ≤o β" using a2 unfolding sc_ord_def by blast
ultimately have "α <o |N|" using ordLeq_ordLess_trans by blast
then show "False" using a1 b1 using not_ordLess_ordLeq ordIso_iff_ordLeq ordLeq_transitive by blast
qed
moreover have "Well_order α0" using a2 unfolding sc_ord_def ordLess_def by blast
moreover have "Well_order |N|" by simp
ultimately show ?thesis using b1 not_ordLess_iff_ordLeq ordIso_iff_ordLeq ordLeq_transitive by blast
qed
lemma lem_restr_ordbnd:
fixes r::"'U rel" and A::"'U set" and α::"'U rel"
assumes a1: "ω_ord ≤o α" and a2: "|A| ≤o α"
shows "|Restr r A| ≤o α"
proof (cases "finite A")
assume "finite A"
then have "finite (Restr r A)" by blast
then have "|Restr r A| <o ω_ord" using finite_iff_ordLess_natLeq by blast
then show "|Restr r A| ≤o α" using a1 ordLeq_transitive ordLess_imp_ordLeq by blast
next
assume "¬ finite A"
then have "|A × A| =o |A|" by simp
moreover have "|Restr r A| ≤o |A × A|" by simp
ultimately show "|Restr r A| ≤o α" using a2 ordLeq_ordIso_trans ordLeq_transitive by blast
qed
lemma lem_card_inf_lim:
fixes r::"'U rel"
assumes a1: "Card_order α" and a2: "ω_ord ≤o α"
shows "¬( α = {} ∨ isSuccOrd α )"
proof -
obtain s where "s = Field α" by blast
then have "|s| =o α" using a1 card_of_Field_ordIso by blast
moreover then have "¬ ( |s| <o |UNIV :: nat set| )" using a2
by (metis card_of_nat ordLess_ordIso_trans not_ordLess_ordIso ordLeq_iff_ordLess_or_ordIso ordLeq_ordLess_trans)
ultimately have "¬ finite (Field α)" using lem_fin_card lem_fin_fl_rel by (metis finite_iff_cardOf_nat ordIso_finite_Field)
moreover then have "α ≠ {}" by force
moreover have "wo_rel α" using a1 unfolding wo_rel_def card_order_on_def by blast
ultimately show ?thesis using a1 card_order_infinite_isLimOrd wo_rel.isLimOrd_def by blast
qed
lemma lem_card_nreg_inf_osetlm:
fixes α::"'U rel"
assumes a1: "Card_order α" and a2: "¬ regularCard α" and a3: "¬ finite (Field α)"
shows "∃ S::'U rel set. |S| <o α ∧ (∀ α'∈S. α' <o α) ∧ (∀ α'::'U rel. α' <o α ⟶ (∃ β ∈ S. α' ≤o β))"
proof -
obtain K::"'U set" where b1: "K ⊆ Field α ∧ cofinal K α" and b2: "¬ |K| =o α"
using a2 unfolding regularCard_def by blast
have b3: "|K| <o α"
proof -
have "|K| ≤o |Field α|" using b1 by simp
moreover have "|Field α| =o α" using a1 card_of_Field_ordIso by blast
ultimately show "|K| <o α" using a1 b2
by (metis card_of_Well_order card_order_on_def not_ordLeq_ordLess ordIso_or_ordLess ordIso_ordLess_trans)
qed
have b4: "isLimOrd α" using a1 a3 card_order_infinite_isLimOrd by blast
obtain f::"'U ⇒ 'U rel" where b5: "f = (λ a. Restr α (under α a))" by blast
obtain S::"'U rel set" where b6: "S = f ` K" by blast
then have "|S| <o α" using b3 card_of_image ordLeq_ordLess_trans by blast
moreover have "∀ α'∈S. α' <o α"
proof
fix α'::"'U rel"
assume c1: "α' ∈ S"
then obtain a where c2: "a ∈ K ∧ α' = Restr α (under α a)" using b5 b6 by blast
then have c3: "Well_order α' ∧ Well_order α" using a1 Well_order_Restr unfolding card_order_on_def by blast
moreover have "embed α' α id"
proof -
have "ofilter α (under α a)" using c3 wo_rel.under_ofilter[of α] unfolding wo_rel_def by blast
moreover then have "under α a ⊆ Field α" unfolding ofilter_def by blast
ultimately show ?thesis using c2 c3 ofilter_embed[of α "under α a"] by blast
qed
moreover have "bij_betw id (Field α') (Field α) ⟶ False"
proof
assume "bij_betw id (Field α') (Field α)"
then have d1: "Field α' = Field α" unfolding bij_betw_def by simp
have "a ∈ Field α" using c2 b1 by blast
then obtain b where d2: "b ∈ aboveS α a"
using b4 c3 wo_rel.isLimOrd_aboveS[of α a] unfolding wo_rel_def by blast
then have "b ∈ Field α'" using d1 unfolding aboveS_def Field_def by blast
then have "b ∈ under α a" using c2 unfolding Field_def by blast
then show "False" using a1 d2 unfolding under_def aboveS_def
card_order_on_def well_order_on_def linear_order_on_def partial_order_on_def antisym_def by blast
qed
ultimately show "α' <o α" using embedS_def unfolding ordLess_def by blast
qed
moreover have "∀ α'::'U rel. α' <o α ⟶ (∃ β ∈ S. α' ≤o β)"
proof (intro allI impI)
fix α'::"'U rel"
assume c1: "α' <o α"
then obtain g where c2: "embed α' α g ∧ ¬ bij_betw g (Field α') (Field α)"
using embedS_def unfolding ordLess_def by blast
then have "g ` Field α' ≠ Field α"
using c1 embed_inj_on unfolding ordLess_def bij_betw_def by blast
moreover have "g ` Field α' ⊆ Field α"
using c1 c2 embed_in_Field[of α' α g] unfolding ordLess_def by fast
ultimately obtain a where c3: "a ∈ Field α - (g ` Field α')" by blast
then obtain b β where c4: "b ∈ K ∧ (a, b) ∈ α ∧ β = f b" using b1 unfolding cofinal_def by blast
then have "β ∈ S" using b6 by blast
moreover have "α' ≤o β"
proof -
have d1: "Well_order β" using c4 b5 a1 Well_order_Restr unfolding card_order_on_def by blast
moreover have "embed α' β g"
proof -
have e1: "∀x y. (x, y) ∈ α' ⟶ (g x, g y) ∈ β"
proof (intro allI impI)
fix x y
assume f1: "(x, y) ∈ α'"
then have f2: "(g x, g y) ∈ α" using c2 embed_compat unfolding compat_def by blast
moreover have "g y ∈ under α b"
proof -
have "(b, g y) ∈ α ⟶ False"
proof
assume "(b, g y) ∈ α"
moreover have "(a, b) ∈ α" using c4 by blast
ultimately have "(a, g y) ∈ α" using a1 unfolding under_def card_order_on_def
well_order_on_def linear_order_on_def partial_order_on_def preorder_on_def trans_def by blast
then have "a ∈ under α (g y)" unfolding under_def by blast
moreover have "bij_betw g (under α' y) (under α (g y))"
using f1 c2 unfolding embed_def Field_def by blast
ultimately obtain y' where "y' ∈ under α' y ∧ a = g y'" unfolding bij_betw_def by blast
moreover then have "y' ∈ Field α'" unfolding under_def Field_def by blast
ultimately have "a ∈ g ` Field α'" by blast
then show "False" using c3 by blast
qed
moreover have "g y ∈ Field α ∧ b ∈ Field α" using f2 c4 unfolding Field_def by blast
ultimately have "(g y, b) ∈ α" using a1 unfolding card_order_on_def well_order_on_def
linear_order_on_def partial_order_on_def preorder_on_def refl_on_def total_on_def by metis
then show ?thesis unfolding under_def by blast
qed
moreover then have "g x ∈ under α b" using a1 f2 unfolding under_def card_order_on_def
well_order_on_def linear_order_on_def partial_order_on_def preorder_on_def trans_def by blast
ultimately have "(g x, g y) ∈ Restr α (under α b)" by blast
then show "(g x, g y) ∈ β" using c4 b5 by blast
qed
have e2: "∀x ∈ g ` Field α'. under β x ⊆ g ` Field α'"
proof
fix x
assume "x ∈ g ` Field α'"
then obtain c where f1: "c ∈ Field α' ∧ x = g c" by blast
have "∀ x'. (x', x) ∈ β ⟶ x' ∈ g ` Field α'"
proof (intro allI impI)
fix x'
assume "(x', x) ∈ β"
then have "(x', g c) ∈ Restr α (under α b)" using b5 f1 c4 by blast
then have "x' ∈ under α (g c)" unfolding under_def by blast
moreover have "bij_betw g (under α' c) (under α (g c))" using f1 c2 unfolding embed_def by blast
ultimately obtain c' where "x' = g c' ∧ c' ∈ under α' c" unfolding bij_betw_def by blast
moreover then have "c' ∈ Field α'" unfolding under_def Field_def by blast
ultimately show "x' ∈ g ` Field α'" by blast
qed
then show "under β x ⊆ g ` Field α'" unfolding under_def by blast
qed
have "compat α' β g" using e1 unfolding compat_def by blast
moreover then have "ofilter β (g ` Field α')" using e2 unfolding ofilter_def compat_def Field_def by blast
moreover have "inj_on g (Field α')" using c1 c2 embed_inj_on unfolding ordLess_def by blast
ultimately show ?thesis using d1 c1 embed_iff_compat_inj_on_ofilter[of α' β g]
unfolding ordLess_def by blast
qed
ultimately show ?thesis using c1 unfolding ordLess_def ordLeq_def by blast
qed
ultimately show "∃ β ∈ S. α' ≤o β" by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_card_un_bnd_stab:
fixes S::"'a set set" and α::"'U rel"
assumes "stable α" and "∀A∈S. |A| <o α" and "|S| <o α"
shows "| ⋃ S | <o α"
using assms stable_UNION[of α S "λ x. x"] by simp
lemma lem_finwo_cardord: "finite α ⟹ Well_order α ⟹ Card_order α"
proof -
assume a1: "finite α" and a2: "Well_order α"
have "∀r. well_order_on (Field α) r ⟶ α ≤o r"
proof (intro allI impI)
fix r
assume "well_order_on (Field α) r"
moreover have "well_order_on (Field α) α" using a2 by blast
moreover have "finite (Field α)" using a1 finite_Field by fastforce
ultimately have "α =o r" using finite_well_order_on_ordIso by blast
then show "α ≤o r" using ordIso_iff_ordLeq by blast
qed
then show ?thesis using a2 unfolding card_order_on_def by blast
qed
lemma lem_finwo_le_w: "finite α ⟹ Well_order α ⟹ α <o natLeq"
proof -
assume a1: "finite α" and a2: "Well_order α"
then have "|Field α| =o α" using lem_finwo_cardord by (metis card_of_Field_ordIso)
moreover have "finite (Field α)" using a1 finite_Field by fastforce
moreover then have "|Field α| <o natLeq" using finite_iff_ordLess_natLeq by blast
ultimately show "α <o natLeq" using ordIso_iff_ordLeq ordLeq_ordLess_trans by blast
qed
lemma lem_wolew_fin: "α <o natLeq ⟹ finite α"
proof -
assume a1: "α <o natLeq"
then have "Well_order α" using a1 unfolding ordLess_def by blast
then have "|Field α| ≤o α" using card_of_least[of "Field α" α] by blast
then have "¬ (natLeq ≤o |Field α| )" using a1 by (metis BNF_Cardinal_Order_Relation.ordLess_Field not_ordLeq_ordLess)
then have "finite (Field α)" using infinite_iff_natLeq_ordLeq by blast
then show "finite α" using finite_subset trancl_subset_Field2 by fastforce
qed
lemma lem_wolew_nat:
assumes a1: "α <o natLeq" and a2: "n = card (Field α)"
shows "α =o (natLeq_on n)"
proof -
have b1: "Well_order α" using a1 unfolding ordLess_def by blast
have b2: "finite α" using a1 lem_wolew_fin by blast
then have "finite (Field α)" using a1 finite_Field by fastforce
then have "|Field α| =o natLeq_on n" using a2 finite_imp_card_of_natLeq_on[of "Field α"] by blast
moreover have "|Field α| =o α" using b1 b2 lem_finwo_cardord by (metis card_of_Field_ordIso)
ultimately show ?thesis using ordIso_symmetric ordIso_transitive by blast
qed
lemma lem_cntset_enum: "|A| =o natLeq ⟹ (∃ f. A = f ` (UNIV::nat set))"
proof -
assume "|A| =o natLeq"
moreover have "|UNIV::nat set| =o natLeq" using card_of_nat by blast
ultimately have "|UNIV::nat set| =o |A|" by (meson ordIso_iff_ordLeq ordIso_ordLeq_trans)
then obtain f where "bij_betw f (UNIV::nat set) A" using card_of_ordIso by blast
then have "A = f ` (UNIV::nat set)" unfolding bij_betw_def by blast
then show ?thesis by blast
qed
lemma lem_oord_int_card_le_inf:
fixes α::"'U rel"
assumes "ω_ord ≤o α"
shows "|{ γ ∈ 𝒪::'U rel set. γ <o α }| ≤o α"
proof -
obtain f::"'U ⇒ 'U rel" where b1: "f = (λ a. nord (Restr α (underS α a)))" by blast
have "∀ γ ∈ 𝒪::'U rel set. γ <o α ⟶ γ ∈ f ` (Field α)"
proof (intro ballI impI)
fix γ::"'U rel"
assume c1: "γ ∈ 𝒪" and c2: "γ <o α"
have "∃ a ∈ Field α. γ =o Restr α (underS α a)"
using c2 ordLess_iff_ordIso_Restr[of α γ] unfolding ordLess_def by blast
then obtain a where "a ∈ Field α ∧ γ =o Restr α (underS α a)" by blast
moreover then have "γ = f a" using c1 b1 lem_nord_eq lem_Onord by blast
ultimately show "γ ∈ f ` (Field α)" by blast
qed
then have "{ γ ∈ 𝒪::'U rel set. γ<o α } ⊆ f ` (Field α)" by blast
then have "|{ γ ∈ 𝒪::'U rel set. γ <o α }| ≤o |f ` (Field α)|" by simp
moreover have "|f ` (Field α)| ≤o |Field α|" by simp
ultimately have "|{ γ ∈ 𝒪::'U rel set. γ <o α }| ≤o |Field α|" using ordLeq_transitive by blast
moreover have "|Field α| ≤o α" using assms by simp
ultimately show ?thesis using ordLeq_transitive by blast
qed
lemma lem_oord_card_le_int_inf:
fixes α::"'U rel"
assumes a1: "Card_order α" and a2: "ω_ord ≤o α"
shows "α ≤o |{ γ ∈ 𝒪::'U rel set. γ <o α }|"
proof -
obtain α' where b0: "α' = |Field α|" by blast
then have b0': "Card_order α' ∧ α =o α'" using a1 card_of_unique by simp
then have b0'': "ω_ord ≤o α'" using a2 ordLeq_ordIso_trans by blast
obtain f::"'U ⇒ 'U rel" where b1: "f = (λ a. Restr α' (under α' a))" by blast
have b2: "Well_order α'" using b0 by simp
have b3: "∀a ∈ Field α'. ∀b ∈ Field α'. f a =o f b ⟶ a = b"
proof (intro ballI impI)
fix a b
assume d1: "a ∈ Field α'" and d2: "b ∈ Field α'" and "f a =o f b"
then have d3: "f a ≤o f b ∧ f b ≤o f a" using ordIso_iff_ordLeq by blast
obtain A B where d4: "A = under α' a ∧ B = under α' b" by blast
have d5: "Well_order α'" using b0 by simp
moreover then have "wo_rel.ofilter α' A ∧ wo_rel.ofilter α' B"
using d4 wo_rel_def wo_rel.under_ofilter[of α'] by blast
moreover have "Restr α' A ≤o Restr α' B" and "Restr α' B ≤o Restr α' A"
using d3 d4 b1 by blast+
ultimately have "A = B" using ofilter_subset_ordLeq[of α'] by blast
then have "under α' a = under α' b" using d4 by blast
moreover have "(a,a) ∈ α' ∧ (b,b) ∈ α'" using d1 d2 d5
by (metis preorder_on_def partial_order_on_def linear_order_on_def
well_order_on_def refl_on_def)
ultimately have "(a,b) ∈ α' ∧ (b,a) ∈ α'" unfolding under_def by blast
then show "a = b" using d5
by (metis partial_order_on_def linear_order_on_def well_order_on_def antisym_def)
qed
have b4: "∀ a ∈ Field α'. f a <o α'"
proof
fix a
assume c1: "a ∈ Field α'"
have "under α' a ⊂ Field α'"
proof -
have "¬ finite α'" using b0'' Field_natLeq finite_Field infinite_UNIV_nat ordLeq_finite_Field by metis
then have "¬ finite (Field α')" using lem_fin_fl_rel by blast
then obtain a' where "a' ∈ Field α' ∧ a ≠ a' ∧ (a, a') ∈ α'"
using c1 b0' infinite_Card_order_limit[of α' a] by blast
moreover then have "(a', a) ∉ α'" using b2 unfolding well_order_on_def
linear_order_on_def partial_order_on_def antisym_def by blast
ultimately show ?thesis unfolding under_def Field_def by blast
qed
moreover have "ofilter α' (under α' a)"
using b2 wo_rel.under_ofilter[of α'] unfolding wo_rel_def by blast
ultimately show "f a <o α'" unfolding b1 using b2 ofilter_ordLess by blast
qed
obtain g where b5: "g = nord ∘ f" by blast
have "∀x∈Field α'. ∀y∈Field α'. g x = g y ⟶ x = y"
proof (intro ballI impI)
fix x y
assume c1: "x ∈ Field α'" and c2: "y ∈ Field α'" and "g x = g y"
then have "Well_order (f x) ∧ Well_order (f y) ∧ nord (f x) = nord (f y)"
using b4 b5 unfolding ordLess_def by simp
then have "f x =o f y" using lem_nord_req by blast
then show "x = y" using c1 c2 b3 by blast
qed
then have "inj_on g (Field α')" unfolding inj_on_def by blast
moreover have "∀ a ∈ Field α'. g a ∈ 𝒪 ∧ g a <o α'"
proof
fix a
assume "a ∈ Field α'"
then have "f a <o α'" using b4 by blast
then have "nord (f a) <o α' ∧ nord (f a) ∈ 𝒪" using lem_nord_ls_l lem_nordO_ls_l by blast
then show "g a ∈ 𝒪 ∧ g a <o α'" using b5 by simp
qed
ultimately have "|Field α'| ≤o |{γ ∈ 𝒪::'U rel set. γ <o α'}|"
using card_of_ordLeq[of "Field α'" "{γ ∈ 𝒪::'U rel set. γ <o α'}"] by blast
moreover have "α =o |Field α'|" using b0 a1 by simp
moreover have "{γ ∈ 𝒪::'U rel set. γ <o α'} = {γ ∈ 𝒪::'U rel set. γ <o α}"
using b0' using ordIso_iff_ordLeq ordLess_ordLeq_trans by blast
ultimately show ?thesis using ordIso_ordLeq_trans by simp
qed
lemma lem_ord_int_card_le_inf:
fixes α::"'U rel" and f :: "'U rel ⇒ 'a"
assumes "∀ α β. α =o β ⟶ f α = f β" and "ω_ord ≤o α"
shows "|f ` { γ::'U rel. γ <o α }| ≤o α"
proof -
obtain I where b1: "I = { γ ∈ 𝒪::'U rel set. γ <o α }" by blast
have "f`{ γ::'U rel. γ <o α } ⊆ f`I"
proof
fix a
assume "a ∈ f`{ γ::'U rel. γ <o α }"
then obtain γ where "a = f γ ∧ γ <o α" by blast
moreover then have "nord γ =o γ ∧ nord γ ∈ I"
using b1 lem_nord_r lem_nord_ls_l lem_nordO_ls_l ordLess_def by blast
ultimately have "a = f (nord γ) ∧ nord γ ∈ I " using assms by metis
then show "a ∈ f`I" by blast
qed
then have "|f`{ γ::'U rel. γ <o α }| ≤o |f`I|" by simp
moreover have "|f`I| ≤o |I|" by simp
moreover have "|I| ≤o α" using b1 assms lem_oord_int_card_le_inf by blast
ultimately show ?thesis using ordLeq_transitive by metis
qed
lemma lem_card_setcv_inf_stab:
fixes α::"'U rel" and A::"'U set"
assumes a1: "Card_order α" and a2: "ω_ord ≤o α" and a3: "|A| ≤o α"
shows "∃ f::('U rel ⇒ 'U). A ⊆ f `{ γ::'U rel. γ <o α } ∧ (∀ γ1 γ2. γ1 =o γ2 ⟶ f γ1 = f γ2)"
proof -
obtain B where b1: "B = { γ ∈ 𝒪::'U rel set. γ <o α }" by blast
then have "|A| ≤o |B|"
using a1 a2 a3 lem_oord_card_le_int_inf[of α] ordLeq_transitive by blast
then obtain g where b2: "A ⊆ g `B" by (metis card_of_ordLeq2 empty_subsetI order_refl)
obtain f where b3: "f = g ∘ nord" by blast
have "A ⊆ f `{ γ::'U rel. γ <o α }"
proof
fix a
assume "a ∈ A"
then obtain γ::"'U rel" where "γ ∈ 𝒪 ∧ γ <o α ∧ a = g γ" using b1 b2 by blast
moreover then have "f γ = g γ" using b3 lem_Onord by force
ultimately show "a ∈ f `{ γ::'U rel. γ <o α }" by force
qed
moreover have "∀ γ1 γ2. γ1 =o γ2 ⟶ f γ1 = f γ2" using b3 lem_nord_eq by force
ultimately show ?thesis by blast
qed
lemma lem_jnfix_gen:
fixes I::"'i set" and leI::"'i rel" and L::"'l set"
and t::"'i×'l ⇒ 'i ⇒ 'n" and jnN::"'n ⇒ 'n ⇒ 'n"
assumes a1:"¬ finite L"
and a2: "|L| <o |I|"
and a3: "∀α∈I. (α,α) ∈ leI"
and a4: "∀α∈I. ∀β∈I. ∀γ∈I. (α,β)∈leI ∧ (β,γ)∈leI ⟶ (α,γ)∈leI"
and a5: "∀α∈I. ∀β∈I. (α,β) ∈ leI ∨ (β,α) ∈ leI"
and a6: "∀β∈I. |{α∈I. (α,β) ∈ leI}| ≤o |L|"
and a7: "∀α∈I. ∃α'∈I. (α,α') ∈ leI ∧ (α',α) ∉ leI"
shows "∃ h. ∀α∈I. ∀β∈I. ∀i∈L. ∀j∈L. ∃ γ∈I. (α,γ)∈leI ∧ (β,γ)∈leI ∧ (γ,α)∉leI ∧ (γ,β)∉leI
∧ h γ = jnN (t (α,i) γ) (t (β,j) γ)"
proof -
obtain inc where p1: "inc = (λ α. SOME α'. α' ∈ I ∧ (α,α') ∈ leI ∧ (α',α) ∉ leI)" by blast
have p2: "⋀ α. α ∈ I ⟹ (inc α) ∈ I ∧ (α, inc α) ∈ leI ∧ (inc α, α) ∉ leI"
proof -
fix α
assume "α ∈ I"
moreover obtain P where c1: "P = (λ α'. α' ∈ I ∧ (α,α') ∈ leI ∧ (α',α) ∉ leI)" by blast
ultimately have "∃ α'. P α'" using a7 by blast
then have "P (SOME x. P x)" using someI_ex by metis
moreover have "inc α = (SOME x. P x)" using c1 p1 by blast
ultimately show "(inc α) ∈ I ∧ (α,inc α) ∈ leI ∧ (inc α, α) ∉ leI" using c1 by simp
qed
obtain mxI where m0: "mxI = (λ α β. (if ((α,β) ∈ leI) then β else α))" by blast
then have m1: "∀α∈I. ∀β∈I. mxI α β ∈ I" by simp
obtain maxI where b0: "maxI = (λ α β. inc (mxI α β))" by blast
have q1: "∀α∈I. ∀β∈I. maxI α β ∈ I" using p2 b0 m0 by simp
have q2: "∀α∈I. ∀β∈I. (α, maxI α β) ∈ leI ∧ (β, maxI α β) ∈ leI"
proof (intro ballI)
fix α β
assume c1: "α ∈ I" and c2: "β ∈ I"
moreover then have c3: "(α, mxI α β) ∈ leI ∧ (β, mxI α β) ∈ leI ∧ mxI α β ∈ I"
using m0 m1 a5 by force+
ultimately have "(mxI α β, maxI α β) ∈ leI ∧ maxI α β ∈ I" using b0 p2 by blast
then show "(α, maxI α β) ∈ leI ∧ (β, maxI α β) ∈ leI" using c1 c2 c3 a4 by blast
qed
have q3: "∀ α∈I. ∀β∈I. ∀γ∈I. (maxI α β, γ) ∈ leI ⟶ (α,γ)∈leI ∧ (β,γ)∈leI ∧ (γ,α)∉leI ∧ (γ,β)∉leI"
proof (intro ballI impI)
fix α β γ
assume c1: "α∈I" and c2: "β∈I" and c3: "γ∈I" and c4: "(maxI α β, γ) ∈ leI"
moreover then have c5: "(mxI α β, maxI α β) ∈ leI ∧ maxI α β ∈ I
∧ (maxI α β, mxI α β) ∉ leI ∧ mxI α β ∈ I" using b0 p2 m1 by blast
ultimately have c6: "(mxI α β, γ) ∈ leI" using a4 by blast
have "(α,γ)∈leI ∧ (β,γ)∈leI"
proof (cases "(α,β) ∈ leI")
assume "(α,β) ∈ leI"
moreover then have "(β,γ) ∈ leI" using m0 c6 by simp
ultimately show "(α,γ)∈leI ∧ (β,γ)∈leI" using c1 c2 c3 a4 by blast
next
assume "(α,β) ∉ leI"
then have "(β,α) ∈ leI ∧ (α,γ) ∈ leI" using m0 c1 c2 c6 a5 by force
then show "(α,γ)∈leI ∧ (β,γ)∈leI" using c1 c2 c3 a4 by blast
qed
moreover have "(γ,α) ∈ leI ⟶ False"
proof
assume "(γ,α) ∈ leI"
moreover have "(α, mxI α β) ∈ leI ∧ mxI α β ∈ I" using c1 c2 m0 a5 by force
ultimately have "(γ, mxI α β) ∈ leI" using c1 c3 a4 by blast
then show "False" using c3 c4 c5 a4 by blast
qed
moreover have "(γ,β) ∈ leI ⟶ False"
proof
assume "(γ,β) ∈ leI"
moreover have "(β, mxI α β) ∈ leI ∧ mxI α β ∈ I" using c1 c2 m0 a5 by force
ultimately have "(γ, mxI α β) ∈ leI" using c2 c3 a4 by blast
then show "False" using c3 c4 c5 a4 by blast
qed
ultimately show "(α,γ)∈leI ∧ (β,γ)∈leI ∧ (γ,α)∉leI ∧ (γ,β)∉leI" by blast
qed
have "∃ d. d`I = I×L×I"
proof -
have c1: "¬ finite I" using a1 a2 by (metis card_of_ordLeq_infinite ordLess_imp_ordLeq)
then have "I ≠ {} ∧ L ≠ {}" using a1 by blast
moreover then have "|I| ≤o |L×I| ∧ |L×I| =o |I| ∧ L ≠ {}"
using c1 a1 a2 by (metis card_of_Times_infinite[of I L] ordLess_imp_ordLeq ordIso_iff_ordLeq)
moreover then have "¬ finite (L×I)" using c1 a1 by (metis finite_cartesian_productD2)
ultimately have "|I×(L×I)| ≤o |I|"
by (metis card_of_Times_infinite[of "L×I" I] ordIso_transitive ordIso_iff_ordLeq)
moreover have "I×L×I ≠ {}" using c1 a1 by force
ultimately show ?thesis using card_of_ordLeq2[of "I×(L×I)" I] by blast
qed
then obtain d where b1: "d`I = I×(L×I)" by blast
obtain μ where b2: "μ = (λ γ. SOME m. m`L = ({α∈I. (α,γ)∈leI}×L)×({α∈I. (α,γ)∈leI}×L) )" by blast
have b3: "⋀γ. γ ∈ I ⟹ (μ γ)`L = ({α∈I. (α,γ)∈leI}×L)×({α∈I. (α,γ)∈leI}×L)"
proof -
fix γ
assume c1: "γ ∈ I"
obtain A where c2: "A = {α∈I. (α,γ)∈leI}" by blast
have c3: "A ≠ {}" using c1 c2 a3 unfolding refl_on_def by blast
moreover have "L ≠ {}" using a1 by blast
ultimately have "(A×L)×(A×L) ≠ {}" using a1 by simp
moreover have "|(A×L)×(A×L)| ≤o |L|"
proof -
have "|A| ≤o |L|" using c1 c2 a6 by blast
then have "|A×L| ≤o |L|" using c3 a1 by (metis card_of_Times_infinite[of L A] ordIso_iff_ordLeq)
moreover have "¬ finite (A×L)" using c3 a1 by (metis finite_cartesian_productD2)
ultimately show ?thesis
by (metis card_of_Times_same_infinite[of "A×L"] ordIso_iff_ordLeq ordLeq_transitive)
qed
ultimately have "∃m. m`L = ({α∈I. (α,γ)∈leI}×L)×({α∈I. (α,γ)∈leI}×L)"
using c2 card_of_ordLeq2[of "(A×L)×(A×L)" L] by blast
then show "(μ γ)`L = ({α∈I. (α,γ)∈leI}×L)×({α∈I. (α,γ)∈leI}×L)"
using b2 someI_ex[of "λ m. m`L = ({α∈I. (α,γ)∈leI}×L)×({α∈I. (α,γ)∈leI}×L) "] by blast
qed
obtain φ where b4: "φ = (λ x. μ (fst (d x)) (fst (snd (d x))))" by blast
obtain h where b5: "h = (λ x. jnN (t (fst (φ x)) x) (t (snd (φ x)) x))" by blast
have "∀α∈I. ∀β∈I. ∀i∈L. ∀j∈L. ∃ γ∈I.
(maxI α β, γ) ∈ leI ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ)"
proof (intro ballI)
fix α β i j
assume c1: "α ∈ I" and c2: "β ∈ I" and c3: "i ∈ L" and c4: "j ∈ L"
obtain D where c5: "D = ({α' ∈ I. (α', maxI α β) ∈ leI} × L) × {α' ∈ I. (α', maxI α β) ∈ leI} × L" by blast
have c6: "maxI α β ∈ I" using c1 c2 q1 by blast
have "α ∈ {α' ∈ I. (α', maxI α β) ∈ leI}" using c1 c2 q2 by blast
moreover have "β ∈ {α' ∈ I. (α', maxI α β) ∈ leI}" using c1 c2 q2 by blast
ultimately have "((α,i),(β,j)) ∈ D" using c3 c4 c5 by blast
moreover have "μ (maxI α β) ` L = D" using c5 c6 b3[of "maxI α β"] by blast
ultimately obtain v where c7: "v ∈ L ∧ (μ (maxI α β)) v = ((α,i),(β,j))" by force
obtain A where c8: "A = {maxI α β} × ({v} × I)" by blast
then have "A ⊆ I × L × I" using c6 c7 by blast
then have "∀a∈A. ∃ x∈I. d x = a" using b1 by (metis imageE set_rev_mp)
moreover obtain X where c9: "X = { x∈I. d x ∈ A }" by blast
ultimately have "A = d ` X" by force
then have "|A| ≤o |X|" by simp
moreover have "|I| =o |A|"
proof -
obtain f where "f = (λ x::'i. (maxI α β, v, x))" by blast
then have "bij_betw f I A" using c8 unfolding bij_betw_def inj_on_def by force
then show "|I| =o |A|" using card_of_ordIsoI[of f I A] by blast
qed
ultimately have c10: "|L| <o |X|" using a2 by (metis ordLess_ordIso_trans ordLess_ordLeq_trans)
have "∀y∈I. X ⊆ {x∈I. (x,y) ∈ leI} ⟶ False"
proof (intro ballI impI)
fix y
assume "y ∈ I" and "X ⊆ {x∈I. (x,y) ∈ leI}"
then have "y ∈ I ∧ X ⊆ {x∈I. (x,y) ∈ leI}" by blast
moreover then have "|{x∈I. (x,y) ∈ leI}| ≤o |L|" using a6 by blast
ultimately have "|X| ≤o |L|" using card_of_mono1 ordLeq_transitive by blast
then show "False" using c10 by (metis not_ordLeq_ordLess)
qed
then obtain γ where c11: "γ ∈ X ∧ (γ, maxI α β) ∉ leI" using c6 c9 by blast
then obtain w where c12: "γ ∈ I ∧ d γ = (maxI α β, v, w)" using c8 c9 by blast
moreover have "(maxI α β, γ) ∈ leI" using c11 c12 c6 a5 by blast
moreover have "h γ = jnN (t (α,i) γ) (t (β,j) γ)"
proof -
have "φ γ = μ (fst (d γ)) (fst (snd (d γ)))" using b4 by blast
then have "φ γ = μ (maxI α β) v" using c12 by simp
then have "φ γ = ((α,i),(β,j))" using c7 by simp
moreover have "h γ = jnN (t (fst (φ γ)) γ) (t (snd (φ γ)) γ)" using b5 by blast
ultimately show "h γ = jnN (t (α,i) γ) (t (β,j) γ)" by simp
qed
ultimately show "∃ γ∈I. (maxI α β, γ) ∈ leI ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ)" by blast
qed
then show ?thesis using q3 by blast
qed
lemma lem_jnfix_card:
fixes κ::"'U rel" and L::"'l set" and t::"('U rel)×'l ⇒ 'U rel ⇒ 'n" and jnN::"'n ⇒ 'n ⇒ 'n"
and S::"'U rel set"
assumes a1: "Card_order κ" and a2: "¬ finite L" and a3: "|L| <o κ"
and a4: "∀ α ∈ S. |Field α| ≤o |L|"
and a5: "S ⊆ 𝒪" and a6: "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S|"
and a7: "∀ α ∈ S. ∃ β ∈ S. α <o β"
shows "∃ h. ∀ α ∈ S. ∀ β ∈ S. ∀i∈L. ∀j∈L.
(∃ γ ∈ S. α <o γ ∧ β <o γ ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ) )"
proof -
obtain I::"('U rel) set" where c1: "I = S" by blast
obtain leI::"'U rel rel" where c2: "leI = oord" by blast
have "¬ finite L" using a2 by blast
moreover have "|L| <o |I|"
proof -
have "ω_ord ≤o |L|" using a2 by (metis infinite_iff_natLeq_ordLeq)
then have "ω_ord ≤o κ" using a3 by (metis ordLeq_ordLess_trans ordLess_imp_ordLeq)
then obtain f::"'U rel ⇒ 'U" where
d1: "Field κ ⊆ f ` {γ. γ <o κ}" and d2: "∀γ1 γ2. γ1 =o γ2 ⟶ f γ1 = f γ2"
using a1 lem_card_setcv_inf_stab[of κ "Field κ"] by (metis card_of_Field_ordIso ordIso_imp_ordLeq)
then have "|Field κ| ≤o |f ` {γ. γ <o κ}|" by simp
then have "κ ≤o |f ` {γ. γ <o κ}|" using a1
by (metis card_of_Field_ordIso ordIso_imp_ordLeq ordLeq_transitive ordIso_symmetric)
moreover have "|f ` {γ. γ <o κ}| ≤o |{α ∈ 𝒪::'U rel set. α <o κ}|"
proof -
have "κ ≠ {}" using a2 a3
using lem_cardord_emp by (metis Field_empty card_of_Field_ordIso card_of_empty not_ordLess_ordIso ordLeq_ordLess_trans)
then have "({}::'U rel) <o κ" using a1
by (metis ozero_def iso_ozero_empty card_order_on_well_order_on ordIso_symmetric ordLeq_iff_ordLess_or_ordIso ozero_ordLeq)
then have e1: "f ` {γ. γ <o κ} ≠ {}" by blast
moreover have "f ` {γ. γ <o κ} ⊆ f ` {α ∈ 𝒪. α <o κ}"
proof
fix y
assume "y ∈ f ` {γ. γ <o κ}"
then obtain γ α where f1: "γ <o κ ∧ y = f γ ∧ α = nord γ" by blast
moreover then have f2: "α ∈ 𝒪 ∧ α =o γ" using lem_nord_r unfolding 𝒪_def ordLess_def by blast
ultimately have "α <o κ" using d2 ordIso_ordLess_trans by blast
moreover have "y = f α" using d2 f1 f2 by fastforce
ultimately show "y ∈ f ` {α ∈ 𝒪. α <o κ}" using f2 by blast
qed
ultimately have "f ` {α ∈ 𝒪. α <o κ} = f ` {γ. γ <o κ}" by blast
then show ?thesis using e1 card_of_ordLeq2[of "f ` {γ. γ <o κ}" "{α ∈ 𝒪::'U rel set. α <o κ}"] by blast
qed
ultimately have "κ ≤o |{α ∈ 𝒪::'U rel set. α <o κ}|" using ordLeq_transitive by blast
moreover have "I = S" using c1 by blast
moreover then have "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |I|" using a6 by blast
ultimately have "κ ≤o |I|" using c1 using ordLeq_transitive by blast
then show ?thesis using a3 by (metis ordLess_ordLeq_trans)
qed
moreover have "∀α∈I. (α,α) ∈ leI"
using c1 c2 a5 lem_fld_oord lem_oord_wo unfolding well_order_on_def linear_order_on_def
partial_order_on_def preorder_on_def refl_on_def by blast
moreover have "∀α∈I. ∀β∈I. ∀γ∈I. (α,β)∈leI ∧ (β,γ)∈leI ⟶ (α,γ)∈leI"
using c2 lem_oord_wo unfolding well_order_on_def linear_order_on_def
partial_order_on_def preorder_on_def trans_def by blast
moreover have "∀α∈𝒪. ∀β∈𝒪. (α,β) ∈ leI ∨ (β,α) ∈ leI"
using c1 c2 lem_fld_oord lem_oord_wo unfolding well_order_on_def linear_order_on_def total_on_def
partial_order_on_def preorder_on_def refl_on_def by metis
moreover then have "∀α∈I. ∀β∈I. (α,β) ∈ leI ∨ (β,α) ∈ leI" using c1 a5 by blast
moreover have "∀β∈I. |{α∈I. (α,β) ∈ leI}| ≤o |L|"
proof
fix β
assume d1: "β ∈ I"
show "|{α∈I. (α,β) ∈ leI}| ≤o |L|"
proof (cases "ω_ord ≤o β")
assume e1: "ω_ord ≤o β"
obtain C where e2: "C = nord ` {α::'U rel. α <o β}" by blast
have "{α∈I. (α,β) ∈ leI} ⊆ C ∪ {β}"
proof
fix γ
assume "γ ∈ {α∈I. (α,β) ∈ leI}"
then have "γ ∈ 𝒪 ∧ (γ <o β ∨ γ = β)"
using c2 lem_Oeq unfolding oord_def using ordLeq_iff_ordLess_or_ordIso by blast
moreover then have "γ = nord γ" using lem_Onord by blast
ultimately show "γ ∈ C ∪ {β}" using e2 by blast
qed
moreover have "|C ∪ {β}| ≤o β"
proof (cases "finite C")
assume "finite C"
then have "finite (C ∪ {β})" by blast
then have "|C ∪ {β}| <o ω_ord" using finite_iff_ordLess_natLeq by blast
then show ?thesis using e1 ordLess_ordLeq_trans ordLess_imp_ordLeq by blast
next
assume "¬ finite C"
then have "|C ∪ {β}| =o |C|" by (metis card_of_singl_ordLeq finite.simps card_of_Un_infinite)
then show ?thesis using e1 e2 lem_nord_eq lem_ord_int_card_le_inf[of nord β] ordIso_ordLeq_trans by blast
qed
ultimately have "|{α∈I. (α,β) ∈ leI}| ≤o β" by (meson card_of_mono1 ordLeq_transitive)
moreover have "⋀ A::'U rel set. |A| ≤o β ⟹ |A| ≤o |Field β|"
by (metis Field_card_of card_of_mono1 internalize_card_of_ordLeq)
ultimately have "|{α∈I. (α,β) ∈ leI}| ≤o |Field β|" by blast
moreover have "|Field β| ≤o |L|" using d1 c1 a4 by blast
ultimately show "|{α∈I. (α,β) ∈ leI}| ≤o |L|" using ordLeq_transitive by blast
next
assume "¬ ω_ord ≤o β"
then have e1: "β <o ω_ord" using d1 c1 a5 using lem_Owo Field_natLeq natLeq_well_order_on by force
then have e2: "β =o natLeq_on (card (Field β))" using lem_wolew_nat by blast
obtain A where e3: "A = { n. n ≤ card (Field β) }" by blast
obtain f where e4: "f = (λn::nat. SOME α. α ∈ I ∧ α <o ω_ord ∧ card (Field α) = n)" by blast
have "{α∈I. (α,β) ∈ leI} ⊆ f ` A"
proof
fix γ
assume f1: "γ ∈ {α∈I. (α,β) ∈ leI}"
then have f2: "γ ≤o β" using c2 oord_def by blast
then have f3: "γ <o ω_ord" using e1 ordLeq_ordLess_trans by blast
then have f4: "γ =o natLeq_on (card (Field γ))" using lem_wolew_nat by blast
then have "natLeq_on (card (Field γ)) ≤o natLeq_on (card (Field β))"
using f2 e2 by (meson ordIso_iff_ordLeq ordLeq_transitive)
then have f5: "γ ∈ I ∧ card (Field γ) ∈ A" using f1 e3 natLeq_on_ordLeq_less_eq by blast
moreover obtain γ' where f6: "γ' = f (card (Field γ))" by blast
ultimately have "γ' ∈ I ∧ γ' <o ω_ord ∧ card (Field γ') = card (Field γ)"
using f3 e4 someI_ex[of "λ α. α ∈ I ∧ α <o ω_ord ∧ card (Field α) = card (Field γ)"] by blast
moreover then have "γ' =o natLeq_on (card (Field γ))" using lem_wolew_nat by force
ultimately have "γ ∈ 𝒪 ∧ γ' ∈ 𝒪 ∧ γ' =o γ" using f1 f4 c1 a5 ordIso_symmetric ordIso_transitive by blast
then have "γ' = γ" using lem_Oeq by blast
moreover have "γ' ∈ f ` A" using f5 f6 by blast
ultimately show "γ ∈ f ` A" by blast
qed
then have "finite {α∈I. (α,β) ∈ leI}" using e3 finite_subset by blast
then show "|{α∈I. (α,β) ∈ leI}| ≤o |L|" using a2 ordLess_imp_ordLeq by force
qed
qed
moreover have "∀α∈I. ∃α'∈I. (α,α') ∈ leI ∧ (α',α) ∉ leI"
proof
fix α
assume "α ∈ I"
then obtain α' where d1: "α ∈ S ∧ α' ∈ S ∧ α <o α'" using c1 a7 by blast
then have d2: "α ≤o α' ∧ α ∈ 𝒪 ∧ α' ∈ 𝒪" using a5 ordLess_imp_ordLeq by blast
then have "α' ∈ I ∧ (α,α') ∈ leI" using d1 c1 c2 unfolding oord_def by blast
moreover have "(α',α) ∈ leI ⟶ False"
proof
assume e1: "(α',α) ∈ leI"
then have "α' ≤o α" using c2 unfolding oord_def by blast
then have "α' = α" using d2 lem_Oeq ordIso_iff_ordLeq by blast
then show "False" using d1 ordLess_irreflexive by blast
qed
ultimately show "∃α'∈I. (α,α') ∈ leI ∧ (α',α) ∉ leI" by blast
qed
ultimately obtain h where
c3: "∀α∈I. ∀β∈I. ∀i∈L. ∀j∈L. ∃ γ∈I.
(α,γ)∈leI ∧ (β,γ) ∈ leI ∧ (γ,α)∉leI ∧ (γ,β)∉leI ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ)"
using lem_jnfix_gen[of L I leI jnN t] by blast
have "∀ α ∈ S. ∀ β ∈ S. ∀i∈L. ∀j∈L.
(∃ γ ∈ S. α <o γ ∧ β <o γ ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ))"
proof (intro allI ballI impI)
fix α::"'U rel" and i::'l and β::"'U rel" and j::"'l"
assume d2: "i ∈ L" and d3: "j ∈ L" and "α ∈ S" and "β ∈ S"
then have d4: "α ∈ I ∧ β ∈ I" using c1 a5 by blast
then obtain γ where "γ ∈ I" and "(α,γ) ∈ leI ∧ (β,γ) ∈ leI" and "(γ,α)∉leI ∧ (γ,β)∉leI"
and d6: "h γ = jnN (t (α,i) γ) (t (β,j) γ)" using d2 d3 c3 by blast
then have "γ ∈ 𝒪 ∩ S ∧ α <o γ ∧ β <o γ"
using d4 c1 c2 a5 lem_Oeq unfolding oord_def
by (smt ordLeq_iff_ordLess_or_ordIso subsetCE Int_iff)
moreover have "h γ = jnN (t (α,i) γ) (t (β,j) γ)" using d2 d3 d6 by blast
ultimately show "∃ γ ∈ S. α <o γ ∧ β <o γ ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ)" by blast
qed
then show ?thesis by blast
qed
lemma lem_cardsuc_ls_fldcard:
fixes κ::"'a rel" and α::"'b rel"
assumes a1: "Card_order κ" and a2: "α <o cardSuc κ"
shows "|Field α| ≤o κ"
proof -
have "κ <o |Field α| ⟶ False"
proof
assume "κ <o |Field α|"
moreover have "Card_order |Field α|" by simp
ultimately have "cardSuc κ ≤o |Field α|" using a1 cardSuc_least by blast
moreover have "|Field α| ≤o α" using a2 by simp
ultimately have "cardSuc κ ≤o α" using ordLeq_transitive by blast
then show "False" using a2 not_ordLeq_ordLess by blast
qed
then show "|Field α| ≤o κ" using a1 by simp
qed
lemma lem_jnfix_cardsuc:
fixes L::"'l set" and κ::"'U rel" and t::"('U rel)×'l ⇒ 'U rel ⇒ 'n" and jnN::"'n ⇒ 'n ⇒ 'n"
and S::"'U rel set"
assumes a1: "¬ finite L" and a2: "κ =o cardSuc |L|"
and a3: "S ⊆ {α ∈ 𝒪::'U rel set. α <o κ}" and a4: "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S|"
and a5: "∀ α ∈ S. ∃ β ∈ S. α <o β"
shows "∃ h. ∀ α ∈ S. ∀ β ∈ S. ∀i∈L. ∀j∈L.
(∃ γ ∈ S. α <o γ ∧ β <o γ ∧ h γ = jnN (t (α,i) γ) (t (β,j) γ) )"
proof -
have "Card_order κ" using a2 by (metis Card_order_ordIso cardSuc_Card_order card_of_Card_order)
moreover have "|L| <o κ" using a2 cardSuc_greater[of "|L|"]
by (metis Field_card_of card_of_card_order_on ordIso_iff_ordLeq ordLess_ordLeq_trans)
moreover have "∀α::'U rel. α <o κ ⟶ |Field α| ≤o |L|"
using a2 using lem_cardsuc_ls_fldcard ordLess_ordIso_trans by force
ultimately show ?thesis using a1 a3 a4 a5 lem_jnfix_card[of κ L S jnN t] by blast
qed
lemma lem_Relprop_cl_ccr:
fixes r::"'U rel"
shows "Conelike r ⟹ CCR r"
unfolding CCR_def Conelike_def by fastforce
lemma lem_Relprop_ccr_confl:
fixes r::"'U rel"
shows "CCR r ⟹ confl_rel r"
using lem_rtr_field[of _ _ r] unfolding CCR_def confl_rel_def by blast
lemma lem_Relprop_fin_ccr:
fixes r::"'U rel"
shows "finite r ⟹ CCR r = Conelike r"
proof -
assume a1: "finite r"
have "r ≠ {} ∧ CCR r ⟶ Conelike r"
proof
assume b1: "r ≠ {} ∧ CCR r"
have b2: "finite (Field r)" using a1 finite_Field by fastforce
have "∃ xm ∈ Field r. ∀ x ∈ Field r. (x, xm) ∈ r^*"
proof -
have "{} ⊆ Field r ⟶ (∃ xm ∈ Field r. ∀ x ∈ {}. (x, xm) ∈ r^*)" using b1 Field_def by fastforce
moreover have "⋀ x F. finite F ⟹ x ∉ F ⟹
F ⊆ Field r ⟶ (∃ xm ∈ Field r. ∀ x ∈ F. (x, xm) ∈ r^*) ⟹
insert x F ⊆ Field r ⟶ (∃ xm ∈ Field r. ∀ x ∈ insert x F. (x, xm) ∈ r^*)"
proof
fix x F
assume c1: "finite F" and c2: "x ∉ F" and c3: "F ⊆ Field r ⟶ (∃xm∈Field r. ∀x∈F. (x, xm) ∈ r^*)"
and c4: "insert x F ⊆ Field r"
then obtain xm where c5: "xm ∈ Field r ∧ (∀y∈F. (y, xm) ∈ r^*)" by blast
then obtain xm' where "xm' ∈ Field r ∧ (x, xm') ∈ r^* ∧ (xm, xm') ∈ r^*"
using b1 c4 unfolding CCR_def by blast
moreover then have "∀y∈insert x F. (y, xm') ∈ r^*" using c5 by force
ultimately show "∃xm∈Field r. ∀x∈insert x F. (x, xm) ∈ r^*" by blast
qed
ultimately have "(∃ xm ∈ Field r. ∀ x ∈ Field r. (x, xm) ∈ r^*)"
using b2 finite_induct[of "Field r" "λ A'. A' ⊆ Field r ⟶ (∃ xm ∈ Field r. ∀ x ∈ A'. (x, xm) ∈ r^*)"] by simp
then show "∃ xm ∈ Field r. ∀ x ∈ Field r. (x, xm) ∈ r^*" by blast
qed
then show "Conelike r" using a1 b1 unfolding Conelike_def by blast
qed
then show "CCR r = Conelike r" using lem_Relprop_cl_ccr unfolding Conelike_def by blast
qed
lemma lem_Relprop_ccr_ch_un:
fixes S::"'U rel set"
assumes a1: "∀s∈S. CCR s" and a2: "∀s1∈S. ∀s2∈S. s1 ⊆ s2 ∨ s2 ⊆ s1"
shows "CCR (⋃ S)"
proof -
have "∀a∈Field (⋃S). ∀b∈Field (⋃S). ∃c∈Field (⋃S). (a, c) ∈ (⋃S)^* ∧ (b, c) ∈ (⋃S)^*"
proof (intro ballI)
fix a b
assume c1: "a ∈ Field (⋃S)" and c2: "b ∈ Field (⋃S)"
then obtain s1 s2 where c3: "s1 ∈ S ∧ a ∈ Field s1" and c4: "s2 ∈ S ∧ b ∈ Field s2"
unfolding Field_def by blast
show "∃c∈Field (⋃S). (a,c) ∈ (⋃S)^* ∧ (b,c) ∈ (⋃S)^*"
proof (cases "s1 ⊆ s2")
assume "s1 ⊆ s2"
then have "a ∈ Field s2" using c3 unfolding Field_def by blast
then obtain c where "c ∈ Field s2 ∧ (a,c) ∈ s2^* ∧ (b,c) ∈ s2^*"
using a1 c4 unfolding CCR_def by force
moreover then have "c ∈ Field (⋃S)" using c4 unfolding Field_def by blast
moreover have "s2^* ⊆ (⋃S)^*" using c4 Transitive_Closure.rtrancl_mono[of s2 "⋃S"] by blast
ultimately show "∃c∈Field (⋃S). (a,c) ∈ (⋃S)^* ∧ (b,c) ∈ (⋃S)^*" by blast
next
assume "¬ s1 ⊆ s2"
then have "s2 ⊆ s1" using a2 c3 c4 by blast
then have "b ∈ Field s1" using c4 unfolding Field_def by blast
then obtain c where "c ∈ Field s1 ∧ (a,c) ∈ s1^* ∧ (b,c) ∈ s1^*"
using a1 c3 unfolding CCR_def by force
moreover then have "c ∈ Field (⋃S)" using c3 unfolding Field_def by blast
moreover have "s1^* ⊆ (⋃S)^*" using c3 Transitive_Closure.rtrancl_mono[of s1 "⋃S"] by blast
ultimately show "∃c∈Field (⋃S). (a,c) ∈ (⋃S)^* ∧ (b,c) ∈ (⋃S)^*" by blast
qed
qed
then show ?thesis unfolding CCR_def by blast
qed
lemma lem_Relprop_restr_ch_un:
fixes C::"'U set set" and r::"'U rel"
assumes "∀A1∈C. ∀A2∈C. A1 ⊆ A2 ∨ A2 ⊆ A1"
shows "Restr r (⋃ C) = ⋃ { s. ∃ A ∈ C. s = Restr r A }"
proof
show "Restr r (⋃ C) ⊆ ⋃ { s. ∃ A ∈ C. s = Restr r A }"
proof
fix p
assume "p ∈ Restr r (⋃ C)"
then obtain a b A1 A2 where "p = (a,b) ∧ a ∈ A1 ∧ b ∈ A2 ∧ p ∈ r ∧ A1 ∈ C ∧ A2 ∈ C" by blast
moreover then have "A1 ⊆ A2 ∨ A2 ⊆ A1" using assms by blast
ultimately show "p ∈ ⋃ { s. ∃ A ∈ C. s = Restr r A }" by blast
qed
next
show "⋃ { s. ∃ A ∈ C. s = Restr r A } ⊆ Restr r (⋃ C)" by blast
qed
lemma lem_Inv_restr_rtr:
fixes r::"'U rel" and A::"'U set"
assumes "A ∈ Inv r"
shows "r^* ∩ (A×(UNIV::'U set)) ⊆ (Restr r A)^*"
proof -
have "∀ n. ∀ a b. (a,b) ∈ r^^n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^*"
proof
fix n
show "∀ a b. (a,b) ∈ r^^n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^*"
proof (induct n)
show "∀a b. (a,b) ∈ r ^^ 0 ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^*" by simp
next
fix n
assume d1: "∀a b. (a,b) ∈ r ^^ n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^*"
show "∀a b. (a,b) ∈ r ^^ (Suc n) ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^*"
proof (intro allI impI)
fix a b
assume e1: "(a,b) ∈ r ^^ (Suc n) ∧ a ∈ A"
moreover then obtain c where e2: "(a,c) ∈ r^^n ∧ (c,b) ∈ r" by force
ultimately have e3: "(a,c) ∈ (Restr r A)^*" using d1 by blast
moreover then have "c ∈ A" using e1 using rtranclE by force
then have "(c,b) ∈ Restr r A" using assms e2 unfolding Inv_def by blast
then show "(a,b) ∈ (Restr r A)^*" using e3 by (meson rtrancl.rtrancl_into_rtrancl)
qed
qed
qed
then show ?thesis using rtrancl_power by blast
qed
lemma lem_Inv_restr_rtr2:
fixes r::"'U rel" and A::"'U set"
assumes "A ∈ Inv r"
shows "r^* ∩ (A×(UNIV::'U set)) ⊆ (Restr r A)^* ∩ ((UNIV::'U set)×A)"
proof -
have "∀ n. ∀ a b. (a,b) ∈ r^^n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)"
proof
fix n
show "∀ a b. (a,b) ∈ r^^n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)"
proof (induct n)
show "∀a b. (a,b) ∈ r ^^ 0 ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)" by simp
next
fix n
assume d1: "∀a b. (a,b) ∈ r ^^ n ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)"
show "∀a b. (a,b) ∈ r ^^ (Suc n) ∧ a ∈ A ⟶ (a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)"
proof (intro allI impI)
fix a b
assume e1: "(a,b) ∈ r ^^ (Suc n) ∧ a ∈ A"
moreover then obtain c where e2: "(a,c) ∈ r^^n ∧ (c,b) ∈ r" by force
ultimately have e3: "(a,c) ∈ (Restr r A)^*" using d1 by blast
moreover then have "c ∈ A" using e1 using rtranclE by force
then have e4: "(c,b) ∈ Restr r A" using assms e2 unfolding Inv_def by blast
ultimately have "(a,b) ∈ (Restr r A)^*" using e3 by (meson rtrancl.rtrancl_into_rtrancl)
then show "(a,b) ∈ (Restr r A)^* ∩ ((UNIV::'U set)×A)" using e4 by blast
qed
qed
qed
then show ?thesis using rtrancl_power by blast
qed
lemma lem_inv_rtr_mem:
fixes r::"'U rel" and A::"'U set" and a b::"'U"
assumes "A ∈ Inv r" and "a ∈ A" and "(a,b) ∈ r^*"
shows "b ∈ A"
using assms lem_Inv_restr_rtr[of A r] rtranclE[of a b] by blast
lemma lem_Inv_ccr_restr:
fixes r::"'U rel" and A::"'U set"
assumes "CCR r" and "A ∈ Inv r"
shows "CCR (Restr r A)"
proof -
have "∀a ∈ Field (Restr r A). ∀b ∈ Field (Restr r A). ∃c ∈ Field (Restr r A). (a,c) ∈ (Restr r A)^* ∧ (b,c) ∈ (Restr r A)^*"
proof (intro ballI)
fix a b
assume c1: "a ∈ Field (Restr r A)" and c2: "b ∈ Field (Restr r A)"
moreover then obtain c where "c ∈ Field r" and "(a,c) ∈ r^* ∧ (b,c) ∈ r^*" using assms unfolding CCR_def Field_def by blast
ultimately have "(a,c) ∈ r^* ∩ (A×(UNIV::'U set)) ∧ (b,c) ∈ r^* ∩ (A×(UNIV::'U set))" unfolding Field_def by blast
then have "(a,c) ∈ (Restr r A)^* ∧ (b,c) ∈ (Restr r A)^*" using assms lem_Inv_restr_rtr by blast
moreover then have "c ∈ Field (Restr r A)" using c1 lem_rtr_field[of a c] by blast
ultimately show "∃c ∈ Field (Restr r A). (a,c) ∈ (Restr r A)^* ∧ (b,c) ∈ (Restr r A)^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
lemma lem_Inv_cl_restr:
fixes r::"'U rel" and A::"'U set"
assumes "Conelike r" and "A ∈ Inv r"
shows "Conelike (Restr r A)"
proof(cases "r = {}")
assume "r = {}"
then show ?thesis unfolding Conelike_def by blast
next
assume "r ≠ {}"
then obtain m where b1: "∀ a ∈ Field r. (a,m) ∈ r^*" using assms unfolding Conelike_def by blast
show "Conelike (Restr r A)"
proof (cases "m ∈ Field (Restr r A)")
assume "m ∈ Field (Restr r A)"
moreover have "∀a ∈ Field (Restr r A). (a,m) ∈ (Restr r A)^*"
using assms lem_Inv_restr_rtr b1 unfolding Field_def by blast
ultimately show "Conelike (Restr r A)" unfolding Conelike_def by blast
next
assume c1: "m ∉ Field (Restr r A)"
have "(Field r) ∩ A ⊆ {m}"
proof
fix a0
assume "a0 ∈ (Field r) ∩ A"
then have "(a0,m) ∈ r^* ∩ (A×(UNIV::'U set))" using b1 by blast
then have "(a0,m) ∈ (Restr r A)^*" using assms lem_Inv_restr_rtr by blast
then show "a0 ∈ {m}" using c1 lem_rtr_field by (metis (full_types) mem_Collect_eq singleton_conv)
qed
then show "Conelike (Restr r A)" unfolding Conelike_def Field_def by blast
qed
qed
lemma lem_Inv_ccr_restr_invdiff:
fixes r::"'U rel" and A B::"'U set"
assumes a1: "CCR (Restr r A)" and a2: "B ∈ Inv (r^-1)"
shows "CCR (Restr r (A - B))"
proof -
have "(Restr r A) `` (A-B) ⊆ (A-B)"
proof
fix b
assume "b ∈ (Restr r A) `` (A-B)"
then obtain a where c2: "a ∈ A-B ∧ (a,b) ∈ (Restr r A)" by blast
moreover then have "b ∉ B" using a2 unfolding Inv_def by blast
ultimately show "b ∈ A - B" by blast
qed
then have "(A-B) ∈ Inv(Restr r A)" unfolding Inv_def by blast
then have "CCR (Restr (Restr r A) (A - B))" using a1 lem_Inv_ccr_restr by blast
moreover have "Restr (Restr r A) (A - B) = Restr r (A-B)" by blast
ultimately show ?thesis by metis
qed
lemma lem_Inv_dncl_invbk: "dncl r A ∈ Inv (r^-1)"
unfolding dncl_def Inv_def apply clarify
using converse_rtrancl_into_rtrancl by (metis ImageI rtrancl_converse rtrancl_converseI)
lemma lem_inv_sf_ext:
fixes r::"'U rel" and A::"'U set"
assumes "A ⊆ Field r"
shows "∃ A' ∈ SF r. A ⊆ A' ∧ (finite A ⟶ finite A') ∧ ((¬ finite A) ⟶ |A'| =o |A| )"
proof -
obtain rs where b4: "rs = r ∪ (r^-1)" by blast
obtain S where b1: "S = (λ a. rs``{a} )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. (f a) ∈ (S' a)" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain A' where b5: "A' = A ∪ (f ` A)" by blast
have "A ∪ (f ` A) ⊆ Field (Restr r A')"
proof
fix x
assume "x ∈ A ∪ (f ` A)"
then obtain a b where c1: "a ∈ A ∧ b = f a ∧ x ∈ {a,b}" by blast
moreover then have "rs `` {a} ≠ {} ⟶ (a, b) ∈ rs" using assms b1 b3 by blast
moreover have "rs `` {a} = {} ⟶ False" using assms c1 b4 unfolding Field_def by blast
moreover have "(a,b) ∈ rs ⟶ {a,b} ⊆ Field (Restr r A')" using c1 b4 b5 unfolding Field_def by blast
ultimately show "x ∈ Field (Restr r A')" by blast
qed
then have "(A ⊆ A') ∧ (A' ∈ SF r)" using b5 unfolding SF_def Field_def by blast
moreover have "finite A ⟶ finite A'" using b5 by blast
moreover have "(¬ finite A) ⟶ |A'| =o |A|" using b5 by simp
ultimately show ?thesis by blast
qed
lemma lem_inv_sf_un:
assumes "S ⊆ SF r"
shows "(⋃ S) ∈ SF r"
using assms unfolding SF_def Field_def by blast
lemma lem_Inv_ccr_sf_inv_diff:
fixes r::"'U rel" and A B::"'U set"
assumes a1: "A ∈ SF r" and a2: "CCR (Restr r A)" and a3: "B ∈ Inv (r^-1)"
shows "(A-B) ∈ SF r ∨ (∃ y::'U. (A-B) = {y})"
proof -
have "∀ a ∈ A - B. a ∉ Field (Restr r (A-B)) ⟶ A - B = {a}"
proof (intro ballI impI)
fix a
assume b1: "a ∈ A - B" and b2: "a ∉ Field (Restr r (A-B))"
then have "¬ (∃ b ∈ A-B. (a,b) ∈ r ∨ (b,a) ∈ r)" unfolding Field_def by blast
then have b3: "∀ b ∈ A. (a,b) ∉ r" using a3 b1 unfolding Inv_def by blast
have b4: "∀ x ∈ Field(Restr r A). (x,a) ∈ (Restr r A)^*"
proof
fix x
assume "x ∈ Field(Restr r A)"
moreover then have "a ∈ Field (Restr r A)" using b1 a1 unfolding SF_def by blast
ultimately obtain y where c1: "(a,y) ∈ (Restr r A)^* ∧ (x,y) ∈ (Restr r A)^*"
using a2 unfolding CCR_def by blast
moreover have "(a,y) ∈ (Restr r A)^+ ⟶ False" using b3 tranclD by force
ultimately have "a = y" using rtrancl_eq_or_trancl by metis
then show "(x,a) ∈ (Restr r A)^*" using c1 by blast
qed
have "∀ b ∈ (A-B) - {a}. False"
proof
fix b
assume c1: "b ∈ (A-B) - {a}"
then have "b ∈ Field (Restr r A)" using a1 unfolding SF_def by blast
then have "(b,a) ∈ (Restr r A)^*" using b4 by blast
moreover have "(b,a) ∈ (Restr r A)^+ ⟶ False"
proof
assume "(b,a) ∈ (Restr r A)^+"
then obtain b' where d1: "(b,b') ∈ (Restr r A)^* ∧ (b',a) ∈ Restr r A" using tranclD2 by metis
have d2: "∀ r' a b. (a,b) ∈ Restr r' B = (a ∈ B ∧ b ∈ B ∧ (a,b) ∈ r')"
unfolding Field_def by force
have "(b,b') ∈ r^*" using d1 rtrancl_mono[of "Restr r A"] by blast
then have "(b',b) ∈ (r^-1)^*" using rtrancl_converse by blast
then have "b' ∈ B ⟶ (b',b) ∈ (Restr (r^-1) B)^*" using a3 lem_Inv_restr_rtr by blast
then have "b' ∈ B ⟶ b ∈ B" using d2 by (metis rtrancl_eq_or_trancl tranclD2)
then have "b' ∈ A - B" using d1 c1 by blast
then have "(b',a) ∈ Restr r (A-B)" using b1 d1 by blast
then have "a ∈ Field (Restr r (A-B))" unfolding Field_def by blast
then show "False" using b2 by blast
qed
ultimately have "b = a" using rtrancl_eq_or_trancl[of b a] by blast
then show "False" using c1 by blast
qed
then show "A - B = {a}" using b1 by blast
qed
then show ?thesis unfolding SF_def Field_def by blast
qed
lemma lem_Inv_ccr_sf_dn_diff:
fixes r::"'U rel" and A D A'::"'U set"
assumes a1: "A ∈ SF r" and a2: "CCR (Restr r A)" and a3: "A' = (A - (dncl r D))"
shows "((A' ∈ SF r) ∧ CCR (Restr r A')) ∨ (∃ y::'U. A' = {y})"
using assms lem_Inv_ccr_restr_invdiff lem_Inv_ccr_sf_inv_diff lem_Inv_dncl_invbk by blast
lemma lem_rseq_tr:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes "∀ i. (xi i, xi (Suc i)) ∈ r"
shows "∀ i j. i < j ⟶ (xi i ∈ Field r ∧ (xi i, xi j) ∈ r^+)"
proof -
have "⋀ j. ∀ i < j. xi i ∈ Field r ∧ (xi i, xi j) ∈ r^+"
proof -
fix j0
show "∀ i < j0. xi i ∈ Field r ∧ (xi i, xi j0) ∈ r^+"
proof (induct j0)
show "∀i<0. xi i ∈ Field r ∧ (xi i, xi 0) ∈ r^+" by blast
next
fix j
assume d1: "∀i<j. xi i ∈ Field r ∧ (xi i, xi j) ∈ r^+"
show "∀i<Suc j. xi i ∈ Field r ∧ (xi i, xi (Suc j)) ∈ r^+"
proof (intro allI impI)
fix i
assume e1: "i < Suc j"
have e2: "(xi j, xi (Suc j)) ∈ r" using assms by simp
show "xi i ∈ Field r ∧ (xi i, xi (Suc j)) ∈ r^+"
proof (cases "i < j")
assume "i < j"
then have "xi i ∈ Field r ∧ (xi i, xi j) ∈ r^+" using d1 by blast
then show ?thesis using e2 by force
next
assume "¬ i < j"
then have "i = j" using e1 by simp
then show ?thesis using e2 unfolding Field_def by blast
qed
qed
qed
qed
then show ?thesis by blast
qed
lemma lem_rseq_rtr:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes "∀ i. (xi i, xi (Suc i)) ∈ r"
shows "∀ i j. i ≤ j ⟶ (xi i ∈ Field r ∧ (xi i, xi j) ∈ r^*)"
proof (intro allI impI)
fix i::nat and j::nat
assume b1: "i ≤ j"
then have "xi i ∈ Field r" using assms unfolding Field_def by blast
moreover have "(xi i, xi j) ∈ r^*"
proof (cases "i = j")
assume "i = j"
then show ?thesis by blast
next
assume "i ≠ j"
then have "i < j" using b1 by simp
moreover have "r^+ ⊆ r^*" by force
ultimately show ?thesis using assms lem_rseq_tr[of xi r] by blast
qed
ultimately show "xi i ∈ Field r ∧ (xi i, xi j) ∈ r^*" by blast
qed
lemma lem_rseq_svacyc_inv_tr:
fixes r::"'U rel" and xi::"nat ⇒ 'U" and a::"'U"
assumes a1: "single_valued r" and a2: "∀ i. (xi i, xi (Suc i)) ∈ r"
shows "⋀ i. (xi i, a) ∈ r^+ ⟹ (∃ j. i<j ∧ a = xi j)"
proof -
fix i
assume "(xi i, a) ∈ r^+"
moreover have "⋀ n. ∀ i a. (xi i, a) ∈ r^^(Suc n) ⟶ (∃ j. i<j ∧ a = xi j)"
proof -
fix n
show "∀ i a. (xi i, a) ∈ r^^(Suc n) ⟶ (∃ j. i<j ∧ a = xi j)"
proof (induct n)
show "∀i a. (xi i, a) ∈ r^^(Suc 0) ⟶ (∃j>i. a = xi j)"
proof (intro allI impI)
fix i a
assume "(xi i, a) ∈ r^^(Suc 0)"
then have "(xi i, a) ∈ r ∧ (xi i, xi (Suc i)) ∈ r" using a2 by simp
then have "a = xi (Suc i)" using a1 unfolding single_valued_def by blast
then show "∃j>i. a = xi j" by force
qed
next
fix n
assume d1: "∀i a. (xi i, a) ∈ r^^(Suc n) ⟶ (∃j>i. a = xi j)"
show "∀i a. (xi i, a) ∈ r ^^ Suc (Suc n) ⟶ (∃j>i. a = xi j)"
proof (intro allI impI)
fix i a
assume "(xi i, a) ∈ r^^(Suc (Suc n))"
then obtain b where "(xi i, b) ∈ r^^(Suc n) ∧ (b, a) ∈ r" by force
moreover then obtain j where e1: "j > i ∧ b = xi j" using d1 by blast
ultimately have "(xi j, a) ∈ r ∧ (xi j, xi (Suc j)) ∈ r" using a2 by blast
then have "a = xi (Suc j)" using a1 unfolding single_valued_def by blast
moreover have "Suc j > i" using e1 by force
ultimately show "∃j>i. a = xi j" by blast
qed
qed
qed
ultimately show "∃ j. i<j ∧ a = xi j" using trancl_power[of _ r] by (metis Suc_pred')
qed
lemma lem_rseq_svacyc_inv_rtr:
fixes r::"'U rel" and xi::"nat ⇒ 'U" and a::"'U"
assumes a1: "single_valued r" and a2: "∀ i. (xi i, xi (Suc i)) ∈ r"
shows "⋀ i. (xi i, a) ∈ r^* ⟹ (∃ j. i≤j ∧ a = xi j)"
proof -
fix i
assume b1: "(xi i, a) ∈ r^*"
show "∃ j. i≤j ∧ a = xi j"
proof (cases "xi i = a")
assume "xi i = a"
then show ?thesis by force
next
assume "xi i ≠ a"
then have "(xi i, a) ∈ r^+" using b1 by (meson rtranclD)
then obtain j where "i<j ∧ a = xi j" using assms lem_rseq_svacyc_inv_tr[of r xi i a] by blast
then have "i ≤ j ∧ a = xi j" by force
then show ?thesis by blast
qed
qed
lemma lem_ccrsv_cfseq:
fixes r::"'U rel"
assumes a1: "r ≠ {}" and a2: "CCR r" and a3: "single_valued r" and a4: "∀x∈Field r. r``{x} ≠ {}"
shows "∃ xi. cfseq r xi"
proof -
have b1: "Field r ≠ {} ∧ (∀ x ∈ Field r. ∃ y. (x,y) ∈ r)"
using a1 a4 unfolding Field_def by force
moreover obtain f where "f = (λ x. SOME y. (x,y) ∈ r)" by blast
ultimately have b2: "∀ x ∈ Field r. (x, f x) ∈ r" by (metis someI_ex)
obtain x0 where b3: "x0 ∈ Field r" using b1 unfolding Field_def by blast
obtain xi::"nat ⇒ 'U" where b4: "xi = (λ n::nat. (f^^n) x0)" by blast
obtain A where b5: "A = xi ` UNIV" by blast
have "r `` A ⊆ A"
proof
fix a
assume "a ∈ r``A"
then obtain i where "(xi i, a) ∈ r" using b5 by blast
moreover then have "(xi i, f (xi i)) ∈ r" using b2 unfolding Field_def by blast
moreover have "f (xi i) = xi (Suc i)" using b4 by simp
ultimately have "a = xi (Suc i)" using a3 unfolding single_valued_def by blast
then show "a ∈ A" using b5 by blast
qed
then have b6: "A ∈ Inv r" unfolding Inv_def by blast
have "∀ a ∈ Field r. ∃ i. (a, xi i) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain b where "(a,b) ∈ r^* ∧ (x0,b) ∈ r^*" using b3 a2 unfolding CCR_def by blast
moreover have "x0 = xi 0" using b4 by simp
ultimately have "(a,b) ∈ r^* ∧ b ∈ A" using b5 b6 lem_inv_rtr_mem[of A r x0 b] by blast
then show "∃ i. (a, xi i) ∈ r^*" using b5 by blast
qed
moreover have "⋀ i. (xi i, xi (Suc i)) ∈ r"
proof -
fix i0
show "(xi i0, xi (Suc i0)) ∈ r"
proof (induct i0)
show "(xi 0, xi (Suc 0)) ∈ r" using b2 b3 b4 by simp
next
fix i
assume "(xi i, xi (Suc i)) ∈ r"
then have "xi (Suc i) ∈ Field r" unfolding Field_def by blast
then show "(xi (Suc i), xi (Suc (Suc i))) ∈ r" using b2 b3 b4 by simp
qed
qed
ultimately show ?thesis unfolding cfseq_def by blast
qed
lemma lem_cfseq_fld: "cfseq r xi ⟹ xi ` UNIV ⊆ Field r"
using lem_rseq_rtr[of xi r] unfolding cfseq_def by blast
lemma lem_cfseq_inv: "cfseq r xi ⟹ single_valued r ⟹ xi ` UNIV ∈ Inv r"
unfolding cfseq_def single_valued_def Inv_def by blast
lemma lem_scfinv_scf_int: "A ∈ SCF r ∩ Inv r ⟹ B ∈ SCF r ⟹ (A ∩ B) ∈ SCF r"
proof -
assume a1: "A ∈ SCF r ∩ Inv r" and a2: "B ∈ SCF r"
moreover have "∀ a ∈ Field r. ∃b∈A ∩ B. (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain a' where b1: "a' ∈ A ∧ a' ∈ Field r ∧ (a,a') ∈ r^*" using a1 unfolding SCF_def by blast
moreover then obtain b where b2: "b ∈ B ∧ (a',b) ∈ r^*" using a2 unfolding SCF_def by blast
ultimately have "(a, b) ∈ r^*" by force
moreover have "b ∈ A ∩ B" using b1 b2 a1 lem_inv_rtr_mem[of A r a' b] by blast
ultimately show "∃ b ∈ A ∩ B. (a, b) ∈ r^*" by blast
qed
ultimately show "(A ∩ B) ∈ SCF r" unfolding SCF_def Inv_def by blast
qed
lemma lem_scf_minr: "a ∈ Field r ⟹ B ∈ SCF r ⟹ ∃ b ∈ B. (a,b) ∈ (r ∩ ((UNIV-B) × UNIV))^*"
proof -
assume a1: "a ∈ Field r" and a2: "B ∈ SCF r"
then obtain b' where b1: "b' ∈ B ∧ (a,b') ∈ r^*" unfolding SCF_def by blast
then obtain n where "(a,b') ∈ r^^n" using rtrancl_power by blast
then obtain f where b2: "f (0::nat) = a ∧ f n = b'" and b3: "∀i<n. (f i, f (Suc i)) ∈ r"
using relpow_fun_conv[of a b'] by blast
obtain N where b4: "N = { i. f i ∈ B }" by blast
obtain s where b5: "s = r ∩ ((UNIV-B) × UNIV)" by blast
obtain m where "m = (LEAST i. i ∈ N)" by blast
moreover have "n ∈ N" using b1 b2 b4 by blast
ultimately have "m ∈ N ∧ m ≤ n ∧ (∀ i ∈ N. m ≤ i)" by (metis LeastI Least_le)
then have "m ≤ n ∧ f m ∈ B ∧ (∀ i < m. f i ∉ B)" using b4 by force
then have "f 0 = a ∧ f m ∈ B ∧ (∀i<m. (f i, f (Suc i)) ∈ s)" using b2 b3 b5 by force
then have "f m ∈ B ∧ (a, f m) ∈ s^*"
using relpow_fun_conv[of a "f m"] rtrancl_power[of _ s] by metis
then show "∃ b ∈ B. (a,b) ∈ (r ∩ ((UNIV-B) × UNIV))^*" using b5 by blast
qed
lemma lem_cfseq_ncl:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes a1: "cfseq r xi" and a2: "¬ Conelike r"
shows "∀ n. ∃ k. n ≤ k ∧ (xi (Suc k), xi k) ∉ r^*"
proof
fix n
have "(∀ k. n ≤ k ⟶ (xi (Suc k), xi k) ∈ r^*) ⟶ False"
proof
assume c1: "∀ k. n ≤ k ⟶ (xi (Suc k), xi k) ∈ r^*"
have "⋀ k. n ≤ k ⟶ (xi k, xi n) ∈ r^*"
proof -
fix k
show "n ≤ k ⟶ (xi k, xi n) ∈ r^*"
proof (induct k)
show "n ≤ 0 ⟶ (xi 0, xi n) ∈ r^*" by blast
next
fix k
assume e1: "n ≤ k ⟶ (xi k, xi n) ∈ r^*"
show "n ≤ Suc k ⟶ (xi (Suc k), xi n) ∈ r^*"
proof
assume f1: "n ≤ Suc k"
show "(xi (Suc k), xi n) ∈ r^*"
proof (cases "n = Suc k")
assume "n = Suc k"
then show ?thesis using c1 by blast
next
assume "n ≠ Suc k"
then have "(xi k, xi n) ∈ r^* ∧ (xi (Suc k), xi k) ∈ r^*" using f1 e1 c1 by simp
then show ?thesis by force
qed
qed
qed
qed
moreover have "∀ k ≤ n. (xi k, xi n) ∈ r^*" using a1 lem_rseq_rtr unfolding cfseq_def by blast
moreover have "∀ k::nat. k ≤ n ∨ n ≤ k" by force
ultimately have b1: "∀ k. (xi k, xi n) ∈ r^*" by blast
have "xi n ∈ Field r" using a1 unfolding cfseq_def Field_def by blast
moreover have b2: "∀ a ∈ Field r. (a, xi n) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain i where "(a, xi i) ∈ r^*" using a1 unfolding cfseq_def by blast
moreover have "(xi i, xi n) ∈ r^*" using b1 by blast
ultimately show "(a, xi n) ∈ r^*" by force
qed
ultimately have "Conelike r" unfolding Conelike_def by blast
then show "False" using a2 by blast
qed
then show "∃ k. n ≤ k ∧ (xi (Suc k), xi k) ∉ r^*" by blast
qed
lemma lem_cfseq_inj:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes a1: "cfseq r xi" and a2: "acyclic r"
shows "inj xi"
proof -
have "∀ i j. xi i = xi j ⟶ i = j"
proof (intro allI impI)
fix i j
assume c1: "xi i = xi j"
have "i < j ⟶ False"
proof
assume "i < j"
then have "(xi i, xi j) ∈ r^+" using a1 lem_rseq_tr unfolding cfseq_def by blast
then show "False" using c1 a2 unfolding acyclic_def by force
qed
moreover have "j < i ⟶ False"
proof
assume "j < i"
then have "(xi j, xi i) ∈ r^+" using a1 lem_rseq_tr unfolding cfseq_def by blast
then show "False" using c1 a2 unfolding acyclic_def by force
qed
ultimately show "i = j" by simp
qed
then show ?thesis unfolding inj_on_def by blast
qed
lemma lem_cfseq_rmon:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes a1: "cfseq r xi" and a2: "single_valued r" and a3: "acyclic r"
shows "∀ i j. (xi i, xi j) ∈ r^+ ⟶ i < j"
proof (intro allI impI)
fix i j
assume c1: "(xi i, xi j) ∈ r^+"
then obtain j' where c2: "i < j' ∧ xi j' = xi j"
using a1 a2 lem_rseq_svacyc_inv_tr[of r xi i] unfolding cfseq_def by metis
have "j ≤ i ⟶ False"
proof
assume d1: "j ≤ i"
then have "(xi j, xi i) ∈ r^*" using c2 a1 lem_rseq_rtr unfolding cfseq_def by blast
then have "(xi i, xi i) ∈ r^+" using c1 by force
then show "False" using a3 unfolding acyclic_def by blast
qed
then show "i < j" by simp
qed
lemma lem_rseq_hd:
assumes "∀i<n. (f i, f (Suc i)) ∈ r"
shows "∀i≤n. (f 0, f i) ∈ r^*"
proof (intro allI impI)
fix i
assume "i ≤ n"
then have "∀j<i. (f j, f (Suc j)) ∈ r" using assms by force
then have "(f 0, f i) ∈ r^^i" using relpow_fun_conv by metis
then show "(f 0, f i) ∈ r^*" using relpow_imp_rtrancl by blast
qed
lemma lem_rseq_tl:
assumes "∀i<n. (f i, f (Suc i)) ∈ r"
shows "∀i≤n. (f i, f n) ∈ r^*"
proof (intro allI impI)
fix i
assume b1: "i ≤ n"
obtain g where b2: "g = (λ j. f (i + j))" by blast
then have "∀j<n-i. (g j, g (Suc j)) ∈ r" using assms by force
moreover have "g 0 = f i ∧ g (n-i) = f n" using b1 b2 by simp
ultimately have "(f i, f n) ∈ r^^(n-i)" using relpow_fun_conv by metis
then show "(f i, f n) ∈ r^*" using relpow_imp_rtrancl by blast
qed
lemma lem_ccext_ntr_rpth: "(a,b) ∈ r^^n = (rpth r a b n ≠ {})"
proof
assume "rpth r a b n ≠ {}"
then obtain f where "f ∈ rpth r a b n" by blast
then show "(a,b) ∈ r^^n" unfolding rpth_def using relpow_fun_conv[of a b] by blast
next
assume "(a,b) ∈ r^^n"
then obtain f where "f ∈ rpth r a b n" unfolding rpth_def using relpow_fun_conv[of a b] by blast
then show "rpth r a b n ≠ {}" by blast
qed
lemma lem_ccext_rtr_rpth: "(a,b) ∈ r^* ⟹ ∃ n. rpth r a b n ≠ {}"
using rtrancl_power lem_ccext_ntr_rpth by metis
lemma lem_ccext_rpth_rtr: "rpth r a b n ≠ {} ⟹ (a,b) ∈ r^*"
using rtrancl_power lem_ccext_ntr_rpth by metis
lemma lem_ccext_rtr_Fne:
fixes r::"'U rel" and a b::'U
shows "(a,b) ∈ r^* = (ℱ r a b ≠ {})"
proof
assume "(a,b) ∈ r^*"
then obtain n f where "f ∈ rpth r a b n" using lem_ccext_rtr_rpth[of a b r] by blast
then have "f`{i. i≤n} ∈ ℱ r a b" unfolding ℱ_def by blast
then show "ℱ r a b ≠ {}" by blast
next
assume "ℱ r a b ≠ {}"
then obtain F where "F ∈ ℱ r a b" by blast
then obtain n::nat and f::"nat ⇒ 'U" where "F = f`{i. i≤n} ∧ f ∈ rpth r a b n" unfolding ℱ_def by blast
then show "(a,b) ∈ r^*" using lem_ccext_rpth_rtr[of r] by blast
qed
lemma lem_ccext_fprop: "ℱ r a b ≠ {} ⟹ 𝔣 r a b ∈ ℱ r a b" unfolding 𝔣_def using some_in_eq by metis
lemma lem_ccext_ffin: "finite (𝔣 r a b)"
proof (cases "ℱ r a b = {}")
assume "ℱ r a b = {}"
then show "finite (𝔣 r a b)" unfolding 𝔣_def by simp
next
assume "ℱ r a b ≠ {}"
then have "𝔣 r a b ∈ ℱ r a b" using lem_ccext_fprop[of r] by blast
then show "finite (𝔣 r a b)" unfolding ℱ_def by force
qed
lemma lem_ccr_fin_subr_ext:
fixes r s::"'U rel"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "finite s"
shows "∃ s'::('U rel). finite s' ∧ CCR s' ∧ s ⊆ s' ∧ s' ⊆ r"
proof -
have "CCR {}" unfolding CCR_def Field_def by blast
then have "{} ⊆ r ⟶ (∃ r''. CCR r'' ∧ {} ⊆ r'' ∧ r'' ⊆ r ∧ finite r'')" by blast
moreover have "⋀ p R. finite R ⟹ p ∉ R ⟹
R ⊆ r ⟶ (∃ r''. CCR r'' ∧ R ⊆ r'' ∧ r'' ⊆ r ∧ finite r'') ⟹
insert p R ⊆ r ⟶ (∃ r''. CCR r'' ∧ insert p R ⊆ r'' ∧ r'' ⊆ r ∧ finite r'')"
proof
fix p R
assume c1: "finite R" and c2: "p ∉ R"
and c3: "R ⊆ r ⟶ (∃ r''. CCR r'' ∧ R ⊆ r'' ∧ r'' ⊆ r ∧ finite r'')" and c4: "insert p R ⊆ r"
then obtain r'' where c5: "CCR r'' ∧ R ⊆ r'' ∧ r'' ⊆ r ∧ finite r''" by blast
show "∃ r'''. CCR r''' ∧ insert p R ⊆ r''' ∧ r''' ⊆ r ∧ finite r'''"
proof (cases "r'' = {}")
assume "r'' = {}"
then have "insert p R ⊆ {p}" using c5 by blast
moreover have "CCR {p}" unfolding CCR_def Field_def by fastforce
ultimately show "∃ r'''. CCR r''' ∧ insert p R ⊆ r''' ∧ r''' ⊆ r ∧ finite r'''" using c4 by blast
next
assume d1: "r'' ≠ {}"
then obtain xm where d2: "xm ∈ Field r'' ∧ (∀ x ∈ Field r''. (x, xm) ∈ r''^*)"
using c5 lem_Relprop_fin_ccr[of r''] unfolding Conelike_def by blast
then have d3: "xm ∈ Field r" using c5 unfolding Field_def by blast
obtain xp yp where d4: "p = (xp, yp)" by force
then have d5: "yp ∈ Field r" using c4 unfolding Field_def by blast
then obtain t where d6: "t ∈ Field r ∧ (xm, t) ∈ r^* ∧ (yp, t) ∈ r^*" using a1 d3 unfolding CCR_def by blast
then obtain n m where d7: "(xm, t) ∈ r^^n ∧ (yp, t) ∈ r^^m" using rtrancl_power by blast
obtain fn where d8: "fn (0::nat) = xm ∧ fn n = t ∧ (∀i<n. (fn i, fn(Suc i)) ∈ r)" using d7 relpow_fun_conv[of xm t] by blast
obtain fm where d9: "fm (0::nat) = yp ∧ fm m = t ∧ (∀i<m. (fm i, fm(Suc i)) ∈ r)" using d7 relpow_fun_conv[of yp t] by blast
obtain A where d10: "A = Field r'' ∪ { xp } ∪ { x. ∃ i≤n. x = fn i } ∪ { x. ∃ i≤m. x = fm i }" by blast
obtain r''' where d11: "r''' = r ∩ (A × A)" by blast
have d12: "r'' ⊆ r'''" using d10 d11 c5 unfolding Field_def by fastforce
then have d13: "Field r'' ⊆ Field r'''" unfolding Field_def by blast
have d14: "r''^* ⊆ r'''^*" using d12 rtrancl_mono by blast
have d15: "∀ i. i<n ⟶ (fn i, fn(Suc i)) ∈ r'''"
proof
fix i
show "i<n ⟶ (fn i, fn(Suc i)) ∈ r'''"
proof (induct i)
show "0 < n ⟶ (fn 0, fn (Suc 0)) ∈ r'''"
proof
assume "0 < n"
moreover then have "(Suc 0) ≤ n" by force
ultimately have "fn 0 ∈ A ∧ fn(Suc 0) ∈ A ∧ (fn 0, fn(Suc 0)) ∈ r" using d8 d10 by fastforce
then show "(fn 0, fn (Suc 0)) ∈ r'''" using d11 by blast
qed
next
fix i
assume g1: "i < n ⟶ (fn i, fn (Suc i)) ∈ r'''"
show "Suc i < n ⟶ (fn (Suc i), fn (Suc (Suc i))) ∈ r'''"
proof
assume "Suc i < n"
moreover then have "Suc (Suc i) ≤ n" by simp
moreover then have "(fn i, fn (Suc i)) ∈ r'''" using g1 by simp
ultimately show "(fn (Suc i), fn (Suc (Suc i))) ∈ r'''" using d8 d10 d11 by blast
qed
qed
qed
have d16: "∀ i. i<m ⟶ (fm i, fm(Suc i)) ∈ r'''"
proof
fix i
show "i<m ⟶ (fm i, fm(Suc i)) ∈ r'''"
proof (induct i)
show "0 < m ⟶ (fm 0, fm (Suc 0)) ∈ r'''"
proof
assume "0 < m"
moreover then have "(Suc 0) ≤ m" by force
ultimately have "fm 0 ∈ A ∧ fm(Suc 0) ∈ A ∧ (fm 0, fm(Suc 0)) ∈ r" using d9 d10 by fastforce
then show "(fm 0, fm (Suc 0)) ∈ r'''" using d11 by blast
qed
next
fix i
assume g1: "i < m ⟶ (fm i, fm (Suc i)) ∈ r'''"
show "Suc i < m ⟶ (fm (Suc i), fm (Suc (Suc i))) ∈ r'''"
proof
assume "Suc i < m"
moreover then have "Suc (Suc i) ≤ m" by simp
moreover then have "(fm i, fm (Suc i)) ∈ r'''" using g1 by simp
ultimately show "(fm (Suc i), fm (Suc (Suc i))) ∈ r'''" using d9 d10 d11 by blast
qed
qed
qed
have d17: "(xm, t) ∈ r'''^*" using d8 d15 relpow_fun_conv[of xm t n r'''] rtrancl_power by blast
then have d18: "t ∈ Field r'''" using d2 d13 by (metis FieldI2 rtrancl.cases subsetCE)
have d19: "(yp, t) ∈ r'''^*" using d9 d16 relpow_fun_conv[of yp t m r'''] rtrancl_power by blast
have d20: "∀ j≤n. (fn j, t) ∈ r'''^*"
proof (intro allI impI)
fix j
assume "j ≤ n"
moreover obtain f' where "f' = (λk. fn (j + k))" by blast
ultimately have "f' 0 = fn j ∧ f' (n - j) = t ∧ (∀i < n - j. (f' i, f' (Suc i)) ∈ r''')"
using d8 d15 by simp
then show "(fn j, t) ∈ r'''^*"
using relpow_fun_conv[of "fn j" t "n - j" r'''] rtrancl_power by blast
qed
have d21: "∀ j≤m. (fm j, t) ∈ r'''^*"
proof (intro allI impI)
fix j
assume "j ≤ m"
moreover obtain f' where "f' = (λk. fm (j + k))" by blast
ultimately have "f' 0 = fm j ∧ f' (m - j) = t ∧ (∀i < m - j. (f' i, f' (Suc i)) ∈ r''')"
using d9 d16 by simp
then show "(fm j, t) ∈ r'''^*"
using relpow_fun_conv[of "fm j" t "m - j" r'''] rtrancl_power by blast
qed
have "r''' ⊆ r" using d11 by blast
moreover have d22: "insert p R ⊆ r'''"
proof -
have "p ∈ r'''" using c4 d4 d9 d10 d11 by blast
moreover have "R ⊆ r'''"
proof
fix p'
assume "p' ∈ R"
moreover then have "p' ∈ Field R × Field R" using Restr_Field by blast
moreover have "Field R ⊆ Field r''" using c5 unfolding Field_def by blast
ultimately show "p' ∈ r'''" using c4 d10 d11 by blast
qed
ultimately show ?thesis by blast
qed
moreover have "finite r'''" using c5 d10 d11 finite_Field by fastforce
moreover have "CCR r'''"
proof -
let ?jn = "λ a b. ∃c ∈ Field r'''. (a,c) ∈ r'''^* ∧ (b,c) ∈ r'''^*"
have "∀a ∈ Field r'''. ∀b ∈ Field r'''. ?jn a b"
proof (intro ballI)
fix a b
assume f1: "a ∈ Field r'''" and f2: "b ∈ Field r'''"
then have f3: "a ∈ A ∧ b ∈ A" using d11 unfolding Field_def by blast
have f4: "(xp, t) ∈ r'''^*" using d4 d19 d22 by force
have "a ∈ Field r'' ⟶ ?jn a b"
proof
assume g1: "a ∈ Field r''"
then have g2: "(a, t) ∈ r'''^*" using d2 d14 d17 by fastforce
have "b ∈ Field r'' ⟶ ?jn a b" using c5 d13 d14 g1 unfolding CCR_def by blast
moreover have "?jn a xp" using d4 d18 d19 d22 g2 by force
moreover have "∀ j≤n. ?jn a (fn j)" using d18 d20 g2 by blast
moreover have "∀ j≤m. ?jn a (fm j)" using d18 d21 g2 by blast
ultimately show "?jn a b" using d10 f3 by blast
qed
moreover have "?jn xp b"
proof -
have "b ∈ Field r'' ⟶ ?jn xp b"
proof
assume "b ∈ Field r''"
then have "(b, xm) ∈ r'''^*" using d14 d2 by blast
then show "?jn xp b" using d17 d18 f4 by force
qed
moreover have "?jn xp xp" using d4 d22 unfolding Field_def by blast
moreover have "∀ j≤n. ?jn xp (fn j)" using d18 d20 f4 by blast
moreover have "∀ j≤m. ?jn xp (fm j)" using d18 d21 f4 by blast
ultimately show "?jn xp b" using d10 f3 by blast
qed
moreover have "∀i≤n. ?jn (fn i) b"
proof (intro allI impI)
fix i
assume g1: "i ≤ n"
have "b ∈ Field r'' ⟶ ?jn (fn i) b"
proof
assume "b ∈ Field r''"
then have "(b, t) ∈ r'''^*" using d2 d14 d17 by fastforce
then show "?jn (fn i) b" using d18 d20 g1 by blast
qed
moreover have "?jn (fn i) xp" using d18 d20 f4 g1 by blast
moreover have "∀ j≤n. ?jn (fn i) (fn j)" using d18 d20 g1 by blast
moreover have "∀ j≤m. ?jn (fn i) (fm j)" using d18 d20 d21 g1 by blast
ultimately show "?jn (fn i) b" using d10 f3 by blast
qed
moreover have "∀i≤m. ?jn (fm i) b"
proof (intro allI impI)
fix i
assume g1: "i ≤ m"
have "b ∈ Field r'' ⟶ ?jn (fm i) b"
proof
assume "b ∈ Field r''"
then have "(b, t) ∈ r'''^*" using d2 d14 d17 by fastforce
then show "?jn (fm i) b" using d18 d21 g1 by blast
qed
moreover have "?jn (fm i) xp" using d18 d21 f4 g1 by blast
moreover have "∀ j≤n. ?jn (fm i) (fn j)" using d18 d20 d21 g1 by blast
moreover have "∀ j≤m. ?jn (fm i) (fm j)" using d18 d21 g1 by blast
ultimately show "?jn (fm i) b" using d10 f3 by blast
qed
ultimately show "?jn a b" using d10 f3 by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
ultimately show "∃ r'''. CCR r''' ∧ insert p R ⊆ r''' ∧ r''' ⊆ r ∧ finite r'''" by blast
qed
qed
ultimately have "∃ r''. CCR r'' ∧ s ⊆ r'' ∧ r'' ⊆ r ∧ finite r''"
using a2 a3 finite_induct[of s "λ h. h ⊆ r ⟶ (∃ r''. CCR r'' ∧ h ⊆ r'' ∧ r'' ⊆ r ∧ finite r'')"] by simp
then show ?thesis by blast
qed
lemma lem_Ccext_fint:
fixes r s::"'U rel" and a b::'U
assumes a1: "Restr r (𝔣 r a b) ⊆ s" and a2: "(a,b) ∈ r^*"
shows "{a, b} ⊆ 𝔣 r a b ∧ (∀ c ∈ 𝔣 r a b. (a,c) ∈ s^* ∧ (c,b) ∈ s^*)"
proof -
obtain A where b1: "A = 𝔣 r a b" by blast
then have "A ∈ ℱ r a b" using a2 lem_ccext_rtr_Fne[of a b r] lem_ccext_fprop[of r] by blast
then obtain n f where b2: "A = f ` {i. i ≤ n}" and b3: "f ∈ rpth r a b n" unfolding ℱ_def by blast
then have "∀ i<n. (f i, f (Suc i)) ∈ Restr r A" unfolding rpth_def by simp
then have b4: "∀ i<n. (f i, f (Suc i)) ∈ s" using a1 b1 by blast
have "{a, b} ⊆ 𝔣 r a b" using b1 b2 b3 unfolding rpth_def by blast
moreover have "∀ c ∈ 𝔣 r a b. (a,c) ∈ s^* ∧ (c,b) ∈ s^*"
proof
fix c
assume "c ∈ 𝔣 r a b"
then obtain k where c1: "k ≤ n ∧ c = f k" using b1 b2 by blast
have "f ∈ rpth s a c k" using c1 b3 b4 unfolding rpth_def by simp
moreover have "(λ i. f (i + k)) ∈ rpth s c b (n - k)" using c1 b3 b4 unfolding rpth_def by simp
ultimately show "(a,c) ∈ s^* ∧ (c,b) ∈ s^*" using lem_ccext_rpth_rtr[of s] by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_subccr_eqfld:
fixes r r'::"'U rel"
assumes "CCR r" and "r ⊆ r'" and "Field r' = Field r"
shows "CCR r'"
proof -
have "∀a∈Field r'. ∀b∈Field r'. ∃c∈Field r'. (a, c) ∈ r'^* ∧ (b, c) ∈ r'^*"
proof (intro ballI)
fix a b
assume "a∈Field r'" and "b∈Field r'"
then have "a ∈ Field r ∧ b ∈ Field r" using assms by blast
then obtain c where "c ∈ Field r ∧ (a, c) ∈ r^* ∧ (b, c) ∈ r^*" using assms unfolding CCR_def by blast
then have "c ∈ Field r' ∧ (a, c) ∈ r'^* ∧ (b, c) ∈ r'^*" using assms rtrancl_mono by blast
then show "∃c∈Field r'. (a, c) ∈ r'^* ∧ (b, c) ∈ r'^*" by blast
qed
then show "CCR r'" unfolding CCR_def by blast
qed
lemma lem_Ccext_finsubccr_pext:
fixes r s::"'U rel" and x::'U
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "finite s" and a5: "x ∈ Field r"
shows "∃ s'::('U rel). finite s' ∧ CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ x ∈ Field s'"
proof -
obtain y where b1: "(x,y) ∈ r ∨ (y,x) ∈ r" using a5 unfolding Field_def by blast
then obtain x' y' where b2: "{x',y'} = {x,y} ∧ (x',y') ∈ r" by blast
obtain s1 where b3: "s1 = s ∪ {(x',y')}" by blast
then have "finite s1" using a3 by blast
moreover have "s1 ⊆ r" using b2 b3 a2 by blast
ultimately obtain s' where b4: "finite s' ∧ CCR s' ∧ s1 ⊆ s' ∧ s' ⊆ r" using a1 lem_ccr_fin_subr_ext[of r s1] by blast
moreover have "x ∈ Field s1" using b2 b3 unfolding Field_def by blast
ultimately have "x ∈ Field s'" unfolding Field_def by blast
then show ?thesis using b3 b4 by blast
qed
lemma lem_Ccext_finsubccr_dext:
fixes r::"'U rel" and A::"'U set"
assumes a1: "CCR r" and a2: "A ⊆ Field r" and a3: "finite A"
shows "∃ s::('U rel). finite s ∧ CCR s ∧ s ⊆ r ∧ A ⊆ Field s"
proof -
have "finite {} ∧ {} ⊆ Field r ⟶ (∃s. finite s ∧ CCR s ∧ s ⊆ r ∧ {} ⊆ Field s)" unfolding CCR_def Field_def by blast
moreover have "∀ x F. finite F ⟶ x ∉ F ⟶
finite F ∧ F ⊆ Field r ⟶ (∃s. finite s ∧ CCR s ∧ s ⊆ r ∧ F ⊆ Field s) ⟶
finite (insert x F) ∧ insert x F ⊆ Field r ⟶
(∃s. finite s ∧ CCR s ∧ s ⊆ r ∧ insert x F ⊆ Field s)"
proof(intro allI impI)
fix x F
assume c1: "finite F" and c2: "x ∉ F" and c3: "finite F ∧ F ⊆ Field r"
and c4: "∃s. finite s ∧ CCR s ∧ s ⊆ r ∧ F ⊆ Field s"
and c5: "finite (insert x F) ∧ insert x F ⊆ Field r"
then obtain s where c6: "finite s ∧ CCR s ∧ s ⊆ r ∧ F ⊆ Field s" by blast
moreover have "x ∈ Field r" using c5 by blast
ultimately obtain s' where "finite s' ∧ CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ x ∈ Field s'"
using a1 lem_Ccext_finsubccr_pext[of r s x] by blast
moreover then have "insert x F ⊆ Field s'" using c6 unfolding Field_def by blast
ultimately show "∃s'. finite s' ∧ CCR s' ∧ s' ⊆ r ∧ insert x F ⊆ Field s'" by blast
qed
ultimately have "finite A ∧ A ⊆ Field r ⟶ (∃s. finite s ∧ CCR s ∧ s ⊆ r ∧ A ⊆ Field s)"
using finite_induct[of A "λ A. finite A ∧ A ⊆ Field r ⟶ (∃ s. finite s ∧ CCR s ∧ s ⊆ r ∧ A ⊆ Field s)"]
by simp
then show ?thesis using a2 a3 by blast
qed
lemma lem_Ccext_infsubccr_pext:
fixes r s::"'U rel" and x::'U
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "¬ finite s" and a5: "x ∈ Field r"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ x ∈ Field s'"
proof -
obtain G::"'U set ⇒ 'U rel set" where b1: "G = (λ A. {t::'U rel. finite t ∧ CCR t ∧ t ⊆ r ∧ A ⊆ Field t})" by blast
obtain g::"'U set ⇒ 'U rel" where b2: "g = (λ A. if A ⊆ Field r ∧ finite A then (SOME t. t ∈ G A) else {})" by blast
have b3: "∀ A. A ⊆ Field r ∧ finite A ⟶ finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)"
proof (intro allI impI)
fix A
assume c1: "A ⊆ Field r ∧ finite A"
then have "g A = (SOME t. t ∈ G A)" using b2 by simp
moreover have "G A ≠ {}" using b1 a1 c1 lem_Ccext_finsubccr_dext[of r A] by blast
ultimately have "g A ∈ G A" using some_in_eq by metis
then show "finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)" using b1 by blast
qed
have b4: "∀ A. ¬ (A ⊆ Field r ∧ finite A) ⟶ g A = {}" using b2 by simp
obtain H::"'U set ⇒ 'U set"
where b5: "H = (λ X. X ∪ ⋃ {S . ∃ a∈X. ∃b∈X. S = Field (g {a,b})})" by blast
obtain ax bx where b6: "(ax, bx) ∈ r ∧ x ∈ {ax, bx}" using a5 unfolding Field_def by blast
obtain D0::"'U set" where b7: "D0 = Field s ∪ {ax, bx}" by blast
obtain Di::"nat ⇒ 'U set" where b8: "Di = (λ n. (H^^n) D0)" by blast
obtain D::"'U set" where b9: "D = ⋃ {X. ∃ n. X = Di n}" by blast
obtain s' where b10: "s' = Restr r D" by blast
have b11: "∀ n. (¬ finite (Di n)) ∧ |Di n| ≤o |s|"
proof
fix n0
show "(¬ finite (Di n0)) ∧ |Di n0| ≤o |s|"
proof (induct n0)
have "finite {ax, bx}" by blast
moreover have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
ultimately have "¬ finite (Field s) ∧ |{ax, bx}| ≤o |Field s|"
using card_of_Well_order card_of_ordLeq_infinite ordLeq_total by metis
then have "|D0| =o |Field s|" using b7 card_of_Un_infinite by blast
moreover have "|Field s| =o |s|" using a3 lem_rel_inf_fld_card by blast
ultimately have "|D0| ≤o |s|" using ordIso_imp_ordLeq ordIso_transitive by blast
moreover have "¬ finite D0" using a3 b7 lem_fin_fl_rel by blast
ultimately show "¬ finite (Di 0) ∧ |Di 0| ≤o |s|" using b8 by simp
next
fix n
assume d1: "(¬ finite (Di n)) ∧ |Di n| ≤o |s|"
moreover then have "|(Di n) × (Di n)| =o |Di n|" by simp
ultimately have d2: "|(Di n) × (Di n)| ≤o |s|" using ordIso_imp_ordLeq ordLeq_transitive by blast
have d3: "∀ a ∈ (Di n). ∀ b ∈ (Di n). |Field (g {a, b})| ≤o |s|"
proof (intro ballI)
fix a b
assume "a ∈ (Di n)" and "b ∈ (Di n)"
have "finite (g {a, b})" using b3 b4 by (metis finite.emptyI)
then have "finite (Field (g {a, b}))" using lem_fin_fl_rel by blast
then have "|Field (g {a, b})| <o |s|" using a3 finite_ordLess_infinite2 by blast
then show "|Field (g {a, b})| ≤o |s|" using ordLess_imp_ordLeq by blast
qed
have d4: "Di (Suc n) = H (Di n)" using b8 by simp
then have "Di n ⊆ Di (Suc n)" using b5 by blast
then have "¬ finite (Di (Suc n))" using d1 finite_subset by blast
moreover have "|Di (Suc n)| ≤o |s|"
proof -
obtain I where e1: "I = (Di n) × (Di n)" by blast
obtain f where e2: "f = (λ (a,b). Field (g {a,b}))" by blast
have "|I| ≤o |s|" using e1 d2 by blast
moreover have "∀i∈I. |f i| ≤o |s|" using e1 e2 d3 by simp
ultimately have "|⋃ i∈I. f i| ≤o |s|" using a3 card_of_UNION_ordLeq_infinite[of s I f] by blast
moreover have "Di (Suc n) = (Di n) ∪ (⋃ i∈I. f i)" using e1 e2 d4 b5 by blast
ultimately show ?thesis using d1 a3 by simp
qed
ultimately show "(¬ finite (Di (Suc n))) ∧ |Di (Suc n)| ≤o |s|" by blast
qed
qed
have b12: "∀ m. ∀ n. n ≤ m ⟶ Di n ≤ Di m"
proof
fix m0
show "∀ n. n ≤ m0 ⟶ Di n ≤ Di m0"
proof (induct m0)
show "∀n≤0. Di n ⊆ Di 0" by blast
next
fix m
assume d1: "∀n≤m. Di n ⊆ Di m"
show "∀n≤Suc m. Di n ⊆ Di (Suc m)"
proof (intro allI impI)
fix n
assume e1: "n ≤ Suc m"
have "Di (Suc m) = H (Di m)" using b8 by simp
moreover have "Di m ⊆ H (Di m)" using b5 by blast
ultimately have "n ≤ m ⟶ Di n ⊆ Di (Suc m)" using d1 by blast
moreover have "n = (Suc m) ∨ n ≤ m" using e1 by force
ultimately show "Di n ⊆ Di (Suc m)" by blast
qed
qed
qed
have "Di 0 ⊆ D" using b9 by blast
then have b13: "Field s ⊆ D" using b7 b8 by simp
then have b14: "s ⊆ s' ∧ s' ⊆ r" using a2 b10 unfolding Field_def by force
moreover have b15: "|D| ≤o |s|"
proof -
have "|UNIV::nat set| ≤o |s|" using a3 infinite_iff_card_of_nat by blast
then have "|⋃ n. Di n| ≤o |s|" using b11 a3 card_of_UNION_ordLeq_infinite[of s UNIV Di] by blast
moreover have "D = (⋃ n. Di n)" using b9 by force
ultimately show ?thesis by blast
qed
moreover have "|s'| =o |s|"
proof -
have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
then have "¬ finite D" using b13 finite_subset by blast
then have "|D × D| =o |D|" by simp
moreover have "s' ⊆ D × D" using b10 by blast
ultimately have "|s'| ≤o |s|" using b15 card_of_mono1 ordLeq_ordIso_trans ordLeq_transitive by metis
moreover have "|s| ≤o |s'|" using b14 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
moreover have "x ∈ Field s'"
proof -
have "Di 0 ⊆ D" using b9 by blast
then have "{ax, bx} ⊆ D" using b7 b8 by simp
then have "(ax, bx) ∈ s'" using b6 b10 by blast
then show ?thesis using b6 unfolding Field_def by blast
qed
moreover have "CCR s'"
proof -
have "∀ a ∈ Field s'. ∀ b ∈ Field s'. ∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field s'" and d2: "b ∈ Field s'"
then have d3: "a ∈ D ∧ b ∈ D" using b10 unfolding Field_def by blast
then obtain ia ib where d4: "a ∈ Di ia ∧ b ∈ Di ib" using b9 by blast
obtain k where d5: "k = (max ia ib)" by blast
then have "ia ≤ k ∧ ib ≤ k" by simp
then have d6: "a ∈ Di k ∧ b ∈ Di k" using d4 b12 by blast
obtain p where d7: "p = g {a,b}" by blast
have "Field p ⊆ H (Di k)" using b5 d6 d7 by blast
moreover have "H (Di k) = Di (Suc k)" using b8 by simp
moreover have "Di (Suc k) ⊆ D" using b9 by blast
ultimately have d8: "Field p ⊆ D" by blast
have "{a, b} ⊆ Field r" using d1 d2 b10 unfolding Field_def by blast
moreover have "finite {a, b}" by simp
ultimately have d9: "CCR p ∧ p ⊆ r ∧ {a,b} ⊆ Field p" using d7 b3 by blast
then obtain c where d10: "c ∈ Field p ∧ (a,c) ∈ p^* ∧ (b,c) ∈ p^*" unfolding CCR_def by blast
have "(p `` D) ⊆ D" using d8 unfolding Field_def by blast
then have "D ∈ Inv p" unfolding Inv_def by blast
then have "p^* ∩ (D×(UNIV::'U set)) ⊆ (Restr p D)^*" using lem_Inv_restr_rtr[of D p] by blast
moreover have "Restr p D ⊆ s'" using d9 b10 by blast
moreover have "(a,c) ∈ p^* ∩ (D×(UNIV::'U set)) ∧ (b,c) ∈ p^* ∩ (D×(UNIV::'U set))" using d10 d3 by blast
ultimately have "(a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" using rtrancl_mono by blast
moreover then have "c ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_finsubccr_set_ext:
fixes r s::"'U rel" and A::"'U set"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "finite s" and a4: "A ⊆ Field r" and a5: "finite A"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A ⊆ Field s'"
proof -
obtain Pt::"'U ⇒ 'U rel" where p1: "Pt = (λ x. {p ∈ r. x = fst p ∨ x = snd p})" by blast
obtain pt::"'U ⇒ 'U×'U" where p2: "pt = (λ x. (SOME p. p ∈ Pt x))" by blast
have "∀ x∈A. Pt x ≠ {}" using a4 unfolding p1 Field_def by force
then have p3: "∀ x∈A. pt x ∈ Pt x" unfolding p2 by (metis (full_types) Collect_empty_eq Collect_mem_eq someI_ex)
have b2: "pt`A ⊆ r" using p1 p3 by blast
obtain s1 where b3: "s1 = s ∪ (pt`A)" by blast
then have "finite s1" using a3 a5 by blast
moreover have "s1 ⊆ r" using b2 b3 a2 by blast
ultimately obtain s' where b4: "finite s' ∧ CCR s' ∧ s1 ⊆ s' ∧ s' ⊆ r" using a1 lem_ccr_fin_subr_ext[of r s1] by blast
moreover have "A ⊆ Field s1"
proof
fix x
assume c1: "x ∈ A"
then have "pt x ∈ s1" using b3 by blast
moreover obtain ax bx where c2: "pt x = (ax,bx)" by force
ultimately have "ax ∈ Field s1 ∧ bx ∈ Field s1" unfolding Field_def by force
then show "x ∈ Field s1" using c1 c2 p1 p3 by force
qed
ultimately have "A ⊆ Field s'" unfolding Field_def by blast
then show ?thesis using b3 b4 by blast
qed
lemma lem_Ccext_infsubccr_set_ext:
fixes r s::"'U rel" and A::"'U set"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "¬ finite s" and a4: "A ⊆ Field r" and a5: "|A| ≤o |Field s|"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A ⊆ Field s'"
proof -
obtain G::"'U set ⇒ 'U rel set" where b1: "G = (λ A. {t::'U rel. finite t ∧ CCR t ∧ t ⊆ r ∧ A ⊆ Field t})" by blast
obtain g::"'U set ⇒ 'U rel" where b2: "g = (λ A. if A ⊆ Field r ∧ finite A then (SOME t. t ∈ G A) else {})" by blast
have b3: "∀ A. A ⊆ Field r ∧ finite A ⟶ finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)"
proof (intro allI impI)
fix A
assume c1: "A ⊆ Field r ∧ finite A"
then have "g A = (SOME t. t ∈ G A)" using b2 by simp
moreover have "G A ≠ {}" using b1 a1 c1 lem_Ccext_finsubccr_dext[of r A] by blast
ultimately have "g A ∈ G A" using some_in_eq by metis
then show "finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)" using b1 by blast
qed
have b4: "∀ A. ¬ (A ⊆ Field r ∧ finite A) ⟶ g A = {}" using b2 by simp
obtain H::"'U set ⇒ 'U set"
where b5: "H = (λ X. X ∪ ⋃ {S . ∃ a∈X. ∃b∈X. S = Field (g {a,b})})" by blast
obtain Pt::"'U ⇒ 'U rel" where p1: "Pt = (λ x. {p ∈ r. x = fst p ∨ x = snd p})" by blast
obtain pt::"'U ⇒ 'U×'U" where p2: "pt = (λ x. (SOME p. p ∈ Pt x))" by blast
have "∀ x∈A. Pt x ≠ {}" using a4 unfolding p1 Field_def by force
then have p3: "∀ x∈A. pt x ∈ Pt x" unfolding p2 by (metis (full_types) Collect_empty_eq Collect_mem_eq someI_ex)
obtain D0 where b7: "D0 = Field s ∪ fst`(pt`A) ∪ snd`(pt`A)" by blast
obtain Di::"nat ⇒ 'U set" where b8: "Di = (λ n. (H^^n) D0)" by blast
obtain D::"'U set" where b9: "D = ⋃ {X. ∃ n. X = Di n}" by blast
obtain s' where b10: "s' = Restr r D" by blast
have b11: "∀ n. (¬ finite (Di n)) ∧ |Di n| ≤o |s|"
proof
fix n0
show "(¬ finite (Di n0)) ∧ |Di n0| ≤o |s|"
proof (induct n0)
have "|D0| =o |Field s|"
proof -
have "|fst`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c1: "|fst`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|snd`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c2: "|snd`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|fst`(pt`A)| ≤o |Field s| ∧ |snd`(pt`A)| ≤o |Field s|"
using c1 c2 a5 ordLeq_transitive by blast
moreover have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
ultimately have c3: "|D0| ≤o |Field s|" unfolding b7 by simp
have "Field s ⊆ D0" unfolding b7 by blast
then have "|Field s| ≤o |D0|" by simp
then show ?thesis using c3 ordIso_iff_ordLeq by blast
qed
moreover have "|Field s| =o |s|" using a3 lem_rel_inf_fld_card by blast
ultimately have "|D0| ≤o |s|" using ordIso_imp_ordLeq ordIso_transitive by blast
moreover have "¬ finite D0" using a3 b7 lem_fin_fl_rel by blast
ultimately show "¬ finite (Di 0) ∧ |Di 0| ≤o |s|" using b8 by simp
next
fix n
assume d1: "(¬ finite (Di n)) ∧ |Di n| ≤o |s|"
moreover then have "|(Di n) × (Di n)| =o |Di n|" by simp
ultimately have d2: "|(Di n) × (Di n)| ≤o |s|" using ordIso_imp_ordLeq ordLeq_transitive by blast
have d3: "∀ a ∈ (Di n). ∀ b ∈ (Di n). |Field (g {a, b})| ≤o |s|"
proof (intro ballI)
fix a b
assume "a ∈ (Di n)" and "b ∈ (Di n)"
have "finite (g {a, b})" using b3 b4 by (metis finite.emptyI)
then have "finite (Field (g {a, b}))" using lem_fin_fl_rel by blast
then have "|Field (g {a, b})| <o |s|" using a3 finite_ordLess_infinite2 by blast
then show "|Field (g {a, b})| ≤o |s|" using ordLess_imp_ordLeq by blast
qed
have d4: "Di (Suc n) = H (Di n)" using b8 by simp
then have "Di n ⊆ Di (Suc n)" using b5 by blast
then have "¬ finite (Di (Suc n))" using d1 finite_subset by blast
moreover have "|Di (Suc n)| ≤o |s|"
proof -
obtain I where e1: "I = (Di n) × (Di n)" by blast
obtain f where e2: "f = (λ (a,b). Field (g {a,b}))" by blast
have "|I| ≤o |s|" using e1 d2 by blast
moreover have "∀i∈I. |f i| ≤o |s|" using e1 e2 d3 by simp
ultimately have "|⋃ i∈I. f i| ≤o |s|" using a3 card_of_UNION_ordLeq_infinite[of s I f] by blast
moreover have "Di (Suc n) = (Di n) ∪ (⋃ i∈I. f i)" using e1 e2 d4 b5 by blast
ultimately show ?thesis using d1 a3 by simp
qed
ultimately show "(¬ finite (Di (Suc n))) ∧ |Di (Suc n)| ≤o |s|" by blast
qed
qed
have b12: "∀ m. ∀ n. n ≤ m ⟶ Di n ≤ Di m"
proof
fix m0
show "∀ n. n ≤ m0 ⟶ Di n ≤ Di m0"
proof (induct m0)
show "∀n≤0. Di n ⊆ Di 0" by blast
next
fix m
assume d1: "∀n≤m. Di n ⊆ Di m"
show "∀n≤Suc m. Di n ⊆ Di (Suc m)"
proof (intro allI impI)
fix n
assume e1: "n ≤ Suc m"
have "Di (Suc m) = H (Di m)" using b8 by simp
moreover have "Di m ⊆ H (Di m)" using b5 by blast
ultimately have "n ≤ m ⟶ Di n ⊆ Di (Suc m)" using d1 by blast
moreover have "n = (Suc m) ∨ n ≤ m" using e1 by force
ultimately show "Di n ⊆ Di (Suc m)" by blast
qed
qed
qed
have "Di 0 ⊆ D" using b9 by blast
then have b13: "Field s ⊆ D" using b7 b8 by simp
then have b14: "s ⊆ s' ∧ s' ⊆ r" using a2 b10 unfolding Field_def by force
moreover have b15: "|D| ≤o |s|"
proof -
have "|UNIV::nat set| ≤o |s|" using a3 infinite_iff_card_of_nat by blast
then have "|⋃ n. Di n| ≤o |s|" using b11 a3 card_of_UNION_ordLeq_infinite[of s UNIV Di] by blast
moreover have "D = (⋃ n. Di n)" using b9 by force
ultimately show ?thesis by blast
qed
moreover have "|s'| =o |s|"
proof -
have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
then have "¬ finite D" using b13 finite_subset by blast
then have "|D × D| =o |D|" by simp
moreover have "s' ⊆ D × D" using b10 by blast
ultimately have "|s'| ≤o |s|" using b15 card_of_mono1 ordLeq_ordIso_trans ordLeq_transitive by metis
moreover have "|s| ≤o |s'|" using b14 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
moreover have "A ⊆ Field s'"
proof
fix x
assume c1: "x ∈ A"
obtain ax bx where c2: "ax = fst (pt x) ∧ bx = snd (pt x)" by blast
have "pt x ∈ Pt x" using c1 p3 by blast
then have c3: "(ax, bx) ∈ r ∧ x ∈ {ax,bx}" using c2 p1 by simp
have "{ax, bx} ⊆ D0" using b7 c1 c2 by blast
moreover have "Di 0 ⊆ D" using b9 by blast
moreover have "Di 0 = D0" using b8 by simp
ultimately have "{ax, bx} ⊆ D" by blast
then have "(ax, bx) ∈ s'" using c3 b10 by blast
then show "x ∈ Field s'" using c3 unfolding Field_def by blast
qed
moreover have "CCR s'"
proof -
have "∀ a ∈ Field s'. ∀ b ∈ Field s'. ∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field s'" and d2: "b ∈ Field s'"
then have d3: "a ∈ D ∧ b ∈ D" using b10 unfolding Field_def by blast
then obtain ia ib where d4: "a ∈ Di ia ∧ b ∈ Di ib" using b9 by blast
obtain k where d5: "k = (max ia ib)" by blast
then have "ia ≤ k ∧ ib ≤ k" by simp
then have d6: "a ∈ Di k ∧ b ∈ Di k" using d4 b12 by blast
obtain p where d7: "p = g {a,b}" by blast
have "Field p ⊆ H (Di k)" using b5 d6 d7 by blast
moreover have "H (Di k) = Di (Suc k)" using b8 by simp
moreover have "Di (Suc k) ⊆ D" using b9 by blast
ultimately have d8: "Field p ⊆ D" by blast
have "{a, b} ⊆ Field r" using d1 d2 b10 unfolding Field_def by blast
moreover have "finite {a, b}" by simp
ultimately have d9: "CCR p ∧ p ⊆ r ∧ {a,b} ⊆ Field p" using d7 b3 by blast
then obtain c where d10: "c ∈ Field p ∧ (a,c) ∈ p^* ∧ (b,c) ∈ p^*" unfolding CCR_def by blast
have "(p `` D) ⊆ D" using d8 unfolding Field_def by blast
then have "D ∈ Inv p" unfolding Inv_def by blast
then have "p^* ∩ (D×(UNIV::'U set)) ⊆ (Restr p D)^*" using lem_Inv_restr_rtr[of D p] by blast
moreover have "Restr p D ⊆ s'" using d9 b10 by blast
moreover have "(a,c) ∈ p^* ∩ (D×(UNIV::'U set)) ∧ (b,c) ∈ p^* ∩ (D×(UNIV::'U set))" using d10 d3 by blast
ultimately have "(a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" using rtrancl_mono by blast
moreover then have "c ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_finsubccr_pext5:
fixes r::"'U rel" and A B::"'U set" and x::'U
assumes a1: "CCR r" and a2: "finite A" and a3: "A ∈ SF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ finite A'
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B = {y}) ⟶ Field r ⊆ (A'∪B))"
proof -
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B ⊆ {y})) ⟶ y1 ∉ B ∧ y2 ∉ B ∧ y1 ≠ y2" by blast
obtain A1 where b4: "A1 = ({x,y1,y2} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "finite A1" using b4 q3 q4 lem_fin_fl_rel by blast
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A1 ⊆ Field s'"
using a1 q2 q3 lem_Ccext_finsubccr_set_ext[of r s A1] by blast
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "finite (Field s')" using s1 lem_fin_fl_rel by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A')" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
moreover have "finite A'" using s2 s5 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B = {y}) ⟶ Field r ⊆ (A' ∪ B)"
proof
assume c1: "∃ y::'U. A' - B = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B" using c1 c2 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_infsubccr_pext5:
fixes r::"'U rel" and A B::"'U set" and x::'U
assumes a1: "CCR r" and a2: "¬ finite A" and a3: "A ∈ SF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A|
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B = {y}) ⟶ Field r ⊆ (A'∪B))"
proof -
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "¬ finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B ⊆ {y})) ⟶ y1 ∉ B ∧ y2 ∉ B ∧ y1 ≠ y2" by blast
obtain A1 where b4: "A1 = ({x, y1, y2} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "|A1| ≤o |Field s|"
proof -
obtain C1 where c1: "C1 = {x,y1,y2} ∩ Field r" by blast
obtain C2 where c2: "C2 = A ∪ f ` A" by blast
have "¬ finite A" using q4 q3 lem_fin_fl_rel by blast
then have "|C2| =o |A|" using c2 b4 q3 by simp
then have "|C2| ≤o |Field s|" unfolding q4 using ordIso_iff_ordLeq by blast
moreover have c3: "¬ finite (Field s)" using q3 lem_fin_fl_rel by blast
moreover have "|C1| ≤o |Field s|"
proof -
have "|{x,y1,y2}| ≤o |Field s|" using c3
by (meson card_of_Well_order card_of_ordLeq_finite finite.emptyI finite.insertI ordLeq_total)
moreover have "|C1| ≤o |{x,y1,y2}|" unfolding c1 by simp
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately have "|C1 ∪ C2| ≤o |Field s|" unfolding b4 using card_of_Un_ordLeq_infinite by blast
moreover have "A1 = C1 ∪ C2" using c1 c2 b4 by blast
ultimately show ?thesis by blast
qed
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A1 ⊆ Field s'"
using a1 q2 q3 lem_Ccext_infsubccr_set_ext[of r s A1] by blast
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "|Field s'| =o |Field s|" using s1 q3 lem_cardreleq_cardfldeq_inf[of s' s] by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
moreover have "|A'| =o |A1|"
proof -
have "Field s ⊆ A1" using q4 b4 by blast
then have "|Field s| ≤o |A1|" by simp
then have "|A'| ≤o |A1|" using s2 s5 ordIso_ordLeq_trans by blast
moreover have "|A1| ≤o |A'|" using s1 s2 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A1|" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
moreover have "|A'| =o |A|" using s5 s2 q4 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B = {y}) ⟶ Field r ⊆ (A' ∪ B)"
proof
assume c1: "∃ y::'U. A' - B = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B" using c1 c2 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_subccr_pext5:
fixes r::"'U rel" and A B::"'U set" and x::'U
assumes "CCR r" and "A ∈ SF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A')
∧ A ⊆ A'
∧ A' ∈ SF r
∧ (∀a∈A. ((r``{a}⊆B) ∨ (r``{a}∩(A'-B) ≠ {})))
∧ ((∃ y::'U. A'-B = {y}) ⟶ Field r ⊆ (A'∪B))
∧ CCR (Restr r A')
∧ ((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))"
proof (cases "finite A")
assume "finite A"
then show ?thesis using assms lem_Ccext_finsubccr_pext5[of r A x B] by blast
next
assume "¬ finite A"
then show ?thesis using assms lem_Ccext_infsubccr_pext5[of r A x B] by blast
qed
lemma lem_Ccext_finsubccr_set_ext_scf:
fixes r s::"'U rel" and A P::"'U set"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "finite s" and a4: "A ⊆ Field r" and a5: "finite A"
and a6: "P ∈ SCF r"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A ⊆ Field s'
∧ ((Field s' ∩ P) ∈ SCF s')"
proof (cases "s = {} ∧ A = {}")
assume "s = {} ∧ A = {}"
moreover obtain s'::"'U rel" where "s' = {}" by blast
ultimately have "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A ⊆ Field s'
∧ ((Field s' ∩ P) ∈ SCF s')" unfolding CCR_def SCF_def Field_def by blast
then show ?thesis by blast
next
assume b1: "¬ (s = {} ∧ A = {})"
obtain Pt::"'U ⇒ 'U rel" where p1: "Pt = (λ x. {p ∈ r. x = fst p ∨ x = snd p})" by blast
obtain pt::"'U ⇒ 'U×'U" where p2: "pt = (λ x. (SOME p. p ∈ Pt x))" by blast
have "∀ x∈A. Pt x ≠ {}" using a4 unfolding p1 Field_def by force
then have p3: "∀ x∈A. pt x ∈ Pt x" unfolding p2 by (metis (full_types) Collect_empty_eq Collect_mem_eq someI_ex)
have b2: "pt`A ⊆ r" using p1 p3 by blast
obtain s1 where b3: "s1 = s ∪ (pt`A)" by blast
then have "finite s1" using a3 a5 by blast
moreover have "s1 ⊆ r" using b2 b3 a2 by blast
ultimately obtain s2 where b4: "finite s2 ∧ CCR s2 ∧ s1 ⊆ s2 ∧ s2 ⊆ r" using a1 lem_ccr_fin_subr_ext[of r s1] by blast
moreover have "A ⊆ Field s1"
proof
fix x
assume c1: "x ∈ A"
then have "pt x ∈ s1" using b3 by blast
moreover obtain ax bx where c2: "pt x = (ax,bx)" by force
ultimately have "ax ∈ Field s1 ∧ bx ∈ Field s1" unfolding Field_def by force
then show "x ∈ Field s1" using c1 c2 p1 p3 by force
qed
ultimately have b5: "A ⊆ Field s2" unfolding Field_def by blast
have "Conelike s2" using b4 lem_Relprop_fin_ccr by blast
moreover have "s2 ≠ {}" using b1 b3 b4 unfolding Field_def by blast
ultimately obtain m where b6: "m ∈ Field s2 ∧ (∀ a∈Field s2. (a,m) ∈ s2^*)" unfolding Conelike_def by blast
then have "m ∈ Field r" using b4 unfolding Field_def by blast
then obtain m' where b7: "m' ∈ P ∧ (m,m') ∈ r^*" using a6 unfolding SCF_def by blast
obtain D where b8: "D = Field s2 ∪ (𝔣 r m m')" by blast
obtain s' where b9: "s' = Restr r D" by blast
have b10: "s2 ⊆ s'" using b4 b8 b9 unfolding Field_def by force
have b11: "∀ a ∈ Field s'. (a,m') ∈ s'^*"
proof
fix a
assume c1: "a ∈ Field s'"
have c2: "Restr r (𝔣 r m m') ⊆ s'" using b8 b9 by blast
then have c3: "(m,m') ∈ s'^*" using b7 lem_Ccext_fint[of r m m' s'] by blast
show "(a,m') ∈ s'^*"
proof (cases "a ∈ Field s2")
assume "a ∈ Field s2"
then have "(a,m) ∈ s2^*" using b6 by blast
then have "(a,m) ∈ s'^*" using b10 rtrancl_mono by blast
then show "(a,m') ∈ s'^*" using c3 by simp
next
assume "a ∉ Field s2"
then have "a ∈ (𝔣 r m m')" using c1 b8 b9 unfolding Field_def by blast
then show "(a,m') ∈ s'^*" using c2 b7 lem_Ccext_fint[of r m m' s'] by blast
qed
qed
have b12: "m' ∈ Field s'"
proof -
have "m ∈ Field s'" using b6 b10 unfolding Field_def by blast
then have "m ∈ Field s' ∧ (m,m') ∈ s'^*" using b11 by blast
then show "m' ∈ Field s'" using lem_rtr_field by force
qed
have "Field s ⊆ D" using b3 b4 b8 unfolding Field_def by blast
then have "s ⊆ s'" using a2 b9 unfolding Field_def by force
moreover have "s' ⊆ r" using b9 by blast
moreover have "finite s'"
proof -
have "finite (Field s2)" using b4 lem_fin_fl_rel by blast
then have "finite D" using b8 lem_ccext_ffin by simp
then show ?thesis using b9 by blast
qed
moreover have "A ⊆ Field s'" using b5 b10 unfolding Field_def by blast
moreover have "CCR s'"
proof -
have "Conelike s'" using b11 b12 unfolding Conelike_def by blast
then show ?thesis using lem_Relprop_cl_ccr by blast
qed
moreover have "(Field s' ∩ P) ∈ SCF s'" using b7 b11 b12 unfolding SCF_def by blast
ultimately show ?thesis by blast
qed
lemma lem_ccext_scf_sat:
assumes "s ⊆ r" and "Field s = Field r"
shows "SCF s ⊆ SCF r"
using assms rtrancl_mono unfolding SCF_def by blast
lemma lem_Ccext_infsubccr_set_ext_scf2:
fixes r s::"'U rel" and A::"'U set" and Ps::"'U set set"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "¬ finite s" and a4: "A ⊆ Field r"
and a5: "|A| ≤o |Field s|" and a6: "Ps ⊆ SCF r ∧ |Ps| ≤o |Field s|"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A ⊆ Field s'
∧ (∀ P∈Ps. (Field s' ∩ P) ∈ SCF s')"
proof -
obtain q where q0: "q = (λ P a. SOME p. p ∈ P ∧ (a, p) ∈ r^*)" by blast
have q1: "∀ P∈Ps. ∀ a∈Field r. (q P a) ∈ Field r ∧ (q P a) ∈ P ∧ (a, q P a) ∈ r^*"
proof (intro ballI)
fix P a
assume "P ∈ Ps" and "a ∈ Field r"
then show "(q P a) ∈ Field r ∧ (q P a) ∈ P ∧ (a, q P a) ∈ r^*"
using q0 a6 someI_ex[of "λ p. p ∈ P ∧ (a,p) ∈ r^*"] unfolding SCF_def by blast
qed
obtain G::"'U set ⇒ 'U rel set" where b1: "G = (λ A. {t::'U rel. finite t ∧ CCR t ∧ t ⊆ r ∧ A ⊆ Field t})" by blast
obtain g::"'U set ⇒ 'U rel" where b2: "g = (λ A. if A ⊆ Field r ∧ finite A then (SOME t. t ∈ G A) else {})" by blast
have b3: "∀ A. A ⊆ Field r ∧ finite A ⟶ finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)"
proof (intro allI impI)
fix A
assume c1: "A ⊆ Field r ∧ finite A"
then have "g A = (SOME t. t ∈ G A)" using b2 by simp
moreover have "G A ≠ {}" using b1 a1 c1 lem_Ccext_finsubccr_dext[of r A] by blast
ultimately have "g A ∈ G A" using some_in_eq by metis
then show "finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)" using b1 by blast
qed
have b4: "∀ A. ¬ (A ⊆ Field r ∧ finite A) ⟶ g A = {}" using b2 by simp
obtain H::"'U set ⇒ 'U set"
where b5: "H = (λ X. X ∪ ⋃ {S . ∃ a∈X. ∃b∈X. S = Field (g {a,b})} ∪ ⋃ {S. ∃ P∈Ps. ∃ a∈X. S = 𝔣 r a (q P a) })" by blast
obtain Pt::"'U ⇒ 'U rel" where p1: "Pt = (λ x. {p ∈ r. x = fst p ∨ x = snd p})" by blast
obtain pt::"'U ⇒ 'U×'U" where p2: "pt = (λ x. (SOME p. p ∈ Pt x))" by blast
have "∀ x∈A. Pt x ≠ {}" using a4 unfolding p1 Field_def by force
then have p3: "∀ x∈A. pt x ∈ Pt x" unfolding p2 by (metis (full_types) Collect_empty_eq Collect_mem_eq someI_ex)
obtain D0 where b7: "D0 = Field s ∪ fst`(pt`A) ∪ snd`(pt`A)" by blast
obtain Di::"nat ⇒ 'U set" where b8: "Di = (λ n. (H^^n) D0)" by blast
obtain D::"'U set" where b9: "D = ⋃ {X. ∃ n. X = Di n}" by blast
obtain s' where b10: "s' = Restr r D" by blast
have b11: "∀ n. (¬ finite (Di n)) ∧ |Di n| ≤o |s|"
proof
fix n0
show "(¬ finite (Di n0)) ∧ |Di n0| ≤o |s|"
proof (induct n0)
have "|D0| =o |Field s|"
proof -
have "|fst`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c1: "|fst`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|snd`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c2: "|snd`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|fst`(pt`A)| ≤o |Field s| ∧ |snd`(pt`A)| ≤o |Field s|"
using c1 c2 a5 ordLeq_transitive by blast
moreover have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
ultimately have c3: "|D0| ≤o |Field s|" unfolding b7 by simp
have "Field s ⊆ D0" unfolding b7 by blast
then have "|Field s| ≤o |D0|" by simp
then show ?thesis using c3 ordIso_iff_ordLeq by blast
qed
moreover have "|Field s| =o |s|" using a3 lem_rel_inf_fld_card by blast
ultimately have "|D0| ≤o |s|" using ordIso_imp_ordLeq ordIso_transitive by blast
moreover have "¬ finite D0" using a3 b7 lem_fin_fl_rel by blast
ultimately show "¬ finite (Di 0) ∧ |Di 0| ≤o |s|" using b8 by simp
next
fix n
assume d1: "(¬ finite (Di n)) ∧ |Di n| ≤o |s|"
moreover then have "|(Di n) × (Di n)| =o |Di n|" by simp
ultimately have d2: "|(Di n) × (Di n)| ≤o |s|" using ordIso_imp_ordLeq ordLeq_transitive by blast
have d3: "∀ a ∈ (Di n). ∀ b ∈ (Di n). |Field (g {a, b})| ≤o |s|"
proof (intro ballI)
fix a b
assume "a ∈ (Di n)" and "b ∈ (Di n)"
have "finite (g {a, b})" using b3 b4 by (metis finite.emptyI)
then have "finite (Field (g {a, b}))" using lem_fin_fl_rel by blast
then have "|Field (g {a, b})| <o |s|" using a3 finite_ordLess_infinite2 by blast
then show "|Field (g {a, b})| ≤o |s|" using ordLess_imp_ordLeq by blast
qed
have d4: "Di (Suc n) = H (Di n)" using b8 by simp
then have "Di n ⊆ Di (Suc n)" using b5 by blast
then have "¬ finite (Di (Suc n))" using d1 finite_subset by blast
moreover have "|Di (Suc n)| ≤o |s|"
proof -
obtain I where e1: "I = (Di n) × (Di n)" by blast
obtain f where e2: "f = (λ (a,b). Field (g {a,b}))" by blast
have "|I| ≤o |s|" using e1 d2 by blast
moreover have "∀i∈I. |f i| ≤o |s|" using e1 e2 d3 by simp
ultimately have "|⋃ i∈I. f i| ≤o |s|" using a3 card_of_UNION_ordLeq_infinite[of s I f] by blast
moreover have "Di (Suc n) = (Di n) ∪ (⋃ i∈I. f i) ∪ (⋃ P∈Ps. (⋃ a∈(Di n). 𝔣 r a (q P a)))"
using e1 e2 d4 b5 by blast
moreover have "|⋃ P∈Ps. (⋃ a∈(Di n). 𝔣 r a (q P a))| ≤o |s|"
proof -
have "⋀ P. P ∈ Ps ⟹ ∀a∈(Di n). |𝔣 r a (q P a)| ≤o |s|"
using a3 lem_ccext_ffin by (metis card_of_Well_order card_of_ordLeq_infinite ordLeq_total)
then have "⋀ P. P ∈ Ps ⟹ |⋃ a∈(Di n). 𝔣 r a (q P a)| ≤o |s|"
using d1 a3 card_of_UNION_ordLeq_infinite[of s "Di n" "λ a. 𝔣 r a (q _ a)"] by blast
moreover have "|Ps| ≤o |s|" using a3 a6 lem_rel_inf_fld_card[of s] lem_fin_fl_rel[of s]
by (metis ordIso_iff_ordLeq ordLeq_transitive)
ultimately show ?thesis
using a3 card_of_UNION_ordLeq_infinite[of s Ps "λ P. ⋃ a∈(Di n). 𝔣 r a (q P a)"] by blast
qed
ultimately show ?thesis using d1 a3 by simp
qed
ultimately show "(¬ finite (Di (Suc n))) ∧ |Di (Suc n)| ≤o |s|" by blast
qed
qed
have b12: "∀ m. ∀ n. n ≤ m ⟶ Di n ≤ Di m"
proof
fix m0
show "∀ n. n ≤ m0 ⟶ Di n ≤ Di m0"
proof (induct m0)
show "∀n≤0. Di n ⊆ Di 0" by blast
next
fix m
assume d1: "∀n≤m. Di n ⊆ Di m"
show "∀n≤Suc m. Di n ⊆ Di (Suc m)"
proof (intro allI impI)
fix n
assume e1: "n ≤ Suc m"
have "Di (Suc m) = H (Di m)" using b8 by simp
moreover have "Di m ⊆ H (Di m)" using b5 by blast
ultimately have "n ≤ m ⟶ Di n ⊆ Di (Suc m)" using d1 by blast
moreover have "n = (Suc m) ∨ n ≤ m" using e1 by force
ultimately show "Di n ⊆ Di (Suc m)" by blast
qed
qed
qed
have "Di 0 ⊆ D" using b9 by blast
then have b13: "Field s ⊆ D" using b7 b8 by simp
then have b14: "s ⊆ s' ∧ s' ⊆ r" using a2 b10 unfolding Field_def by force
moreover have b15: "|D| ≤o |s|"
proof -
have "|UNIV::nat set| ≤o |s|" using a3 infinite_iff_card_of_nat by blast
then have "|⋃ n. Di n| ≤o |s|" using b11 a3 card_of_UNION_ordLeq_infinite[of s UNIV Di] by blast
moreover have "D = (⋃ n. Di n)" using b9 by force
ultimately show ?thesis by blast
qed
moreover have "|s'| =o |s|"
proof -
have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
then have "¬ finite D" using b13 finite_subset by blast
then have "|D × D| =o |D|" by simp
moreover have "s' ⊆ D × D" using b10 by blast
ultimately have "|s'| ≤o |s|" using b15 card_of_mono1 ordLeq_ordIso_trans ordLeq_transitive by metis
moreover have "|s| ≤o |s'|" using b14 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
moreover have "A ⊆ Field s'"
proof
fix x
assume c1: "x ∈ A"
obtain ax bx where c2: "ax = fst (pt x) ∧ bx = snd (pt x)" by blast
have "pt x ∈ Pt x" using c1 p3 by blast
then have c3: "(ax, bx) ∈ r ∧ x ∈ {ax,bx}" using c2 p1 by simp
have "{ax, bx} ⊆ D0" using b7 c1 c2 by blast
moreover have "Di 0 ⊆ D" using b9 by blast
moreover have "Di 0 = D0" using b8 by simp
ultimately have "{ax, bx} ⊆ D" by blast
then have "(ax, bx) ∈ s'" using c3 b10 by blast
then show "x ∈ Field s'" using c3 unfolding Field_def by blast
qed
moreover have "CCR s'"
proof -
have "∀ a ∈ Field s'. ∀ b ∈ Field s'. ∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field s'" and d2: "b ∈ Field s'"
then have d3: "a ∈ D ∧ b ∈ D" using b10 unfolding Field_def by blast
then obtain ia ib where d4: "a ∈ Di ia ∧ b ∈ Di ib" using b9 by blast
obtain k where d5: "k = (max ia ib)" by blast
then have "ia ≤ k ∧ ib ≤ k" by simp
then have d6: "a ∈ Di k ∧ b ∈ Di k" using d4 b12 by blast
obtain p where d7: "p = g {a,b}" by blast
have "Field p ⊆ H (Di k)" using b5 d6 d7 by blast
moreover have "H (Di k) = Di (Suc k)" using b8 by simp
moreover have "Di (Suc k) ⊆ D" using b9 by blast
ultimately have d8: "Field p ⊆ D" by blast
have "{a, b} ⊆ Field r" using d1 d2 b10 unfolding Field_def by blast
moreover have "finite {a, b}" by simp
ultimately have d9: "CCR p ∧ p ⊆ r ∧ {a,b} ⊆ Field p" using d7 b3 by blast
then obtain c where d10: "c ∈ Field p ∧ (a,c) ∈ p^* ∧ (b,c) ∈ p^*" unfolding CCR_def by blast
have "(p `` D) ⊆ D" using d8 unfolding Field_def by blast
then have "D ∈ Inv p" unfolding Inv_def by blast
then have "p^* ∩ (D×(UNIV::'U set)) ⊆ (Restr p D)^*" using lem_Inv_restr_rtr[of D p] by blast
moreover have "Restr p D ⊆ s'" using d9 b10 by blast
moreover have "(a,c) ∈ p^* ∩ (D×(UNIV::'U set)) ∧ (b,c) ∈ p^* ∩ (D×(UNIV::'U set))" using d10 d3 by blast
ultimately have "(a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" using rtrancl_mono by blast
moreover then have "c ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
moreover have "∀ P∈Ps. (Field s' ∩ P) ∈ SCF s'"
proof -
have "∀ P ∈ Ps. ∀a∈Field s'. ∃b∈(Field s' ∩ P). (a, b) ∈ s'^*"
proof (intro ballI)
fix P a
assume d0: "P ∈ Ps" and d1: "a ∈ Field s'"
then have "a ∈ D" using b10 unfolding Field_def by blast
then obtain n where "a ∈ Di n" using b9 by blast
then have "𝔣 r a (q P a) ⊆ H (Di n)" using d0 b5 by blast
moreover have "H (Di n) = Di (Suc n)" using b8 by simp
ultimately have d2: "𝔣 r a (q P a) ⊆ D" using b9 by blast
have "a ∈ Field r" using d1 b10 unfolding Field_def by blast
then have "q P a ∈ P ∧ (a, q P a) ∈ r^*" using d0 q1 by blast
moreover have "Restr r (𝔣 r a (q P a)) ⊆ s'" using d0 d2 b10 by blast
ultimately have "q P a ∈ P ∧ (a, q P a) ∈ s'^*" using lem_Ccext_fint[of r a "q P a" s'] by blast
moreover then have "q P a ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃b∈(Field s' ∩ P). (a, b) ∈ s'^*" by blast
qed
then show ?thesis unfolding SCF_def by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_finsubccr_pext5_scf2:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set"
assumes a1: "CCR r" and a2: "finite A" and a3: "A ∈ SF r" and a4: "Ps ⊆ SCF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ finite A'
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' = {y}) ⟶ Field r ⊆ (A'∪B'))
∧ ((∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
proof -
obtain P where p0: "P = (if (Ps ≠ {}) then (SOME P. P ∈ Ps) else Field r)" by blast
moreover have "Field r ∈ SCF r" unfolding SCF_def by blast
ultimately have p1: "P ∈ SCF r" using a4 by (metis contra_subsetD some_in_eq)
have p2: "(∃ P. Ps = {P}) ⟶ Ps = {P}" using p0 by fastforce
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B' ⊆ {y})) ⟶ y1 ∉ B' ∧ y2 ∉ B' ∧ y1 ≠ y2" by blast
obtain A1 where b4: "A1 = ({x,y1,y2} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "finite A1" using b4 q3 q4 lem_fin_fl_rel by blast
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A1 ⊆ Field s'"
and s1': "(∃ P. Ps = {P}) ⟶ (Field s' ∩ P) ∈ SCF s'"
using p1 a1 a4 q2 q3 lem_Ccext_finsubccr_set_ext_scf[of r s A1 P] by metis
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "finite (Field s')" using s1 lem_fin_fl_rel by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A')" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
ultimately have "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')" by blast
moreover have "finite A'" using s2 s5 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B' = {y}) ⟶ Field r ⊆ (A' ∪ B')"
proof
assume c1: "∃ y::'U. A' - B' = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B' ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B' ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B' ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B' ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
qed
moreover have "(∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A'))"
proof -
have c1: "s' ⊆ r" using s3 s4 by blast
then have "Field s' = Field (Restr r (Field s'))" using lem_Relprop_fld_sat by blast
moreover have "s' ⊆ Restr r (Field s')" using c1 unfolding Field_def by force
ultimately have "SCF s' ⊆ SCF (Restr r (Field s'))" using lem_ccext_scf_sat[of s' "Restr r (Field s')"] by blast
then show ?thesis using p2 s1' s2 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_infsubccr_pext5_scf2:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set"
assumes a1: "CCR r" and a2: "¬ finite A" and a3: "A ∈ SF r" and a4: "Ps ⊆ SCF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A|
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' = {y}) ⟶ Field r ⊆ (A'∪B'))
∧ ( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
proof -
obtain Ps' where p0: "Ps' = (if ( |Ps| ≤o |A| ) then Ps else {})" by blast
then have p1: "Ps' ⊆ SCF r ∧ |Ps'| ≤o |A|" using a4 by simp
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "¬ finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B' ⊆ {y})) ⟶ y1 ∉ B' ∧ y2 ∉ B' ∧ y1 ≠ y2" by blast
obtain A1 where b4: "A1 = ({x, y1, y2} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "|A1| ≤o |Field s|"
proof -
obtain C1 where c1: "C1 = {x,y1,y2} ∩ Field r" by blast
obtain C2 where c2: "C2 = A ∪ f ` A" by blast
have "¬ finite A" using q4 q3 lem_fin_fl_rel by blast
then have "|C2| =o |A|" using c2 b4 q3 by simp
then have "|C2| ≤o |Field s|" unfolding q4 using ordIso_iff_ordLeq by blast
moreover have c3: "¬ finite (Field s)" using q3 lem_fin_fl_rel by blast
moreover have "|C1| ≤o |Field s|"
proof -
have "|{x,y1,y2}| ≤o |Field s|" using c3
by (meson card_of_Well_order card_of_ordLeq_finite finite.emptyI finite.insertI ordLeq_total)
moreover have "|C1| ≤o |{x,y1,y2}|" unfolding c1 by simp
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately have "|C1 ∪ C2| ≤o |Field s|" unfolding b4 using card_of_Un_ordLeq_infinite by blast
moreover have "A1 = C1 ∪ C2" using c1 c2 b4 by blast
ultimately show ?thesis by blast
qed
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A1 ⊆ Field s'"
and s1': "(∀ P ∈ Ps'. (Field s' ∩ P) ∈ SCF s')"
using p1 a1 q2 q3 q4 lem_Ccext_infsubccr_set_ext_scf2[of r s A1 Ps'] by blast
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "|Field s'| =o |Field s|" using s1 q3 lem_cardreleq_cardfldeq_inf[of s' s] by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
moreover have "|A'| =o |A1|"
proof -
have "Field s ⊆ A1" using q4 b4 by blast
then have "|Field s| ≤o |A1|" by simp
then have "|A'| ≤o |A1|" using s2 s5 ordIso_ordLeq_trans by blast
moreover have "|A1| ≤o |A'|" using s1 s2 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A1|" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
moreover have "|A'| =o |A|" using s5 s2 q4 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B' = {y}) ⟶ Field r ⊆ (A' ∪ B')"
proof
assume c1: "∃ y::'U. A' - B' = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B' ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B' ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B' ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B' ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
qed
moreover have "( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
proof -
have c1: "s' ⊆ r" using s3 s4 by blast
then have "Field s' = Field (Restr r (Field s'))" using lem_Relprop_fld_sat by blast
moreover have "s' ⊆ Restr r (Field s')" using c1 unfolding Field_def by force
ultimately have "SCF s' ⊆ SCF (Restr r (Field s'))" using lem_ccext_scf_sat[of s' "Restr r (Field s')"] by blast
moreover have "|Ps| ≤o |A| ⟶ Ps' = Ps" using p0 by simp
ultimately show ?thesis using s1' s2 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_subccr_pext5_scf2:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set"
assumes "CCR r" and "A ∈ SF r" and "Ps ⊆ SCF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A')
∧ A ⊆ A'
∧ A' ∈ SF r
∧ (∀a∈A. ((r``{a}⊆B) ∨ (r``{a}∩(A'-B) ≠ {})))
∧ ((∃ y::'U. A'-B' = {y}) ⟶ Field r ⊆ (A'∪B'))
∧ CCR (Restr r A')
∧ ((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))
∧ ( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶
(∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
proof (cases "finite A")
assume b1: "finite A"
then obtain A'::"'U set" where b2: "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' = {y}) ⟶ Field r ⊆ (A'∪B'))"
and b3: "finite A' ∧ ((∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using assms lem_Ccext_finsubccr_pext5_scf2[of r A Ps x B B'] by metis
have b4: "((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))"
and b5: "( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using b1 b3 card_of_ordLeq_finite by blast+
show ?thesis
apply (rule exI)
using b2 b4 b5 by force
next
assume b1: "¬ finite A"
then obtain A' where b2: "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' = {y}) ⟶ Field r ⊆ (A'∪B'))"
and b3: "|A'| =o |A| ∧ ( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
using assms lem_Ccext_infsubccr_pext5_scf2[of r A Ps x B B'] by metis
have b4: "((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))"
using b1 b3 by metis
have b5: "( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using b1 b3 by (metis card_of_singl_ordLeq finite.simps)
show ?thesis
apply (rule exI)
using b2 b4 b5 by force
qed
lemma lem_dnEsc_el: "F ∈ dnEsc r A a ⟹ a ∈ F ∧ finite F" unfolding dnEsc_def ℱ_def rpth_def by blast
lemma lem_dnEsc_emp: "dnEsc r A a = {} ⟹ dnesc r A a = { a }" unfolding dnesc_def by simp
lemma lem_dnEsc_ne: "dnEsc r A a ≠ {} ⟹ dnesc r A a ∈ dnEsc r A a"
unfolding dnesc_def using someI_ex[of "λ F. F ∈ dnEsc r A a"] by force
lemma lem_dnesc_in: "a ∈ dnesc r A a ∧ finite (dnesc r A a)"
using lem_dnEsc_emp[of r A a] lem_dnEsc_el[of _ r A a] lem_dnEsc_ne[of r A a] by force
lemma lem_escl_incr: "B ⊆ escl r A B" using lem_dnesc_in[of _ r A] unfolding escl_def by blast
lemma lem_escl_card: "(finite B ⟶ finite (escl r A B)) ∧ (¬ finite B ⟶ |escl r A B| ≤o |B| )"
proof (intro conjI impI)
assume "finite B"
then show "finite (escl r A B)" using lem_dnesc_in[of _ r A] unfolding escl_def by blast
next
assume b1: "¬ finite B"
moreover have "escl r A B = (⋃x∈B. ((dnesc r A) x))" unfolding escl_def by blast
moreover have "∀ x. |(dnesc r A) x| ≤o |B|"
proof
fix x
have "finite (dnesc r A x)" using lem_dnesc_in[of _ r A] by blast
then show "|dnesc r A x| ≤o |B|" using b1 by (meson card_of_Well_order card_of_ordLeq_infinite ordLeq_total)
qed
ultimately show "|escl r A B| ≤o |B|" by (simp add: card_of_UNION_ordLeq_infinite)
qed
lemma lem_Ccext_infsubccr_set_ext_scf3:
fixes r s::"'U rel" and A A0::"'U set" and Ps::"'U set set"
assumes a1: "CCR r" and a2: "s ⊆ r" and a3: "¬ finite s" and a4: "A ⊆ Field r"
and a5: "|A| ≤o |Field s|" and a6: "Ps ⊆ SCF r ∧ |Ps| ≤o |Field s|"
shows "∃ s'::('U rel). CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A ⊆ Field s'
∧ (∀ P∈Ps. (Field s' ∩ P) ∈ SCF s') ∧ (escl r A0 (Field s') ⊆ Field s')
∧ (∃ D. s' = Restr r D) ∧ (Conelike s' ⟶ Conelike r)"
proof -
obtain w where w0: "w = (λ x. SOME y. y ∈ Field r - dncl r {x})" by blast
have w1: "⋀ x. Field r - dncl r {x} ≠ {} ⟹ w x ∈ Field r - dncl r {x}"
proof -
fix x
assume "Field r - dncl r {x} ≠ {}"
then show "w x ∈ Field r - dncl r {x}"
using w0 someI_ex[of "λ y. y ∈ Field r - dncl r {x}"] by force
qed
obtain q where q0: "q = (λ P a. SOME p. p ∈ P ∧ (a, p) ∈ r^*)" by blast
have q1: "∀ P∈Ps. ∀ a∈Field r. (q P a) ∈ Field r ∧ (q P a) ∈ P ∧ (a, q P a) ∈ r^*"
proof (intro ballI)
fix P a
assume "P ∈ Ps" and "a ∈ Field r"
then show "(q P a) ∈ Field r ∧ (q P a) ∈ P ∧ (a, q P a) ∈ r^*"
using q0 a6 someI_ex[of "λ p. p ∈ P ∧ (a,p) ∈ r^*"] unfolding SCF_def by blast
qed
obtain G::"'U set ⇒ 'U rel set" where b1: "G = (λ A. {t::'U rel. finite t ∧ CCR t ∧ t ⊆ r ∧ A ⊆ Field t})" by blast
obtain g::"'U set ⇒ 'U rel" where b2: "g = (λ A. if A ⊆ Field r ∧ finite A then (SOME t. t ∈ G A) else {})" by blast
have b3: "∀ A. A ⊆ Field r ∧ finite A ⟶ finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)"
proof (intro allI impI)
fix A
assume c1: "A ⊆ Field r ∧ finite A"
then have "g A = (SOME t. t ∈ G A)" using b2 by simp
moreover have "G A ≠ {}" using b1 a1 c1 lem_Ccext_finsubccr_dext[of r A] by blast
ultimately have "g A ∈ G A" using some_in_eq by metis
then show "finite (g A) ∧ CCR (g A) ∧ (g A) ⊆ r ∧ A ⊆ Field (g A)" using b1 by blast
qed
have b4: "∀ A. ¬ (A ⊆ Field r ∧ finite A) ⟶ g A = {}" using b2 by simp
obtain H::"'U set ⇒ 'U set"
where b5: "H = (λ X. X ∪ ⋃ {S. ∃ a∈X. ∃b∈X. S = Field (g {a,b})}
∪ ⋃ {S. ∃ P∈Ps. ∃ a∈X. S = 𝔣 r a (q P a) }
∪ escl r A0 X ∪ (w`X) )" by blast
obtain Pt::"'U ⇒ 'U rel" where p1: "Pt = (λ x. {p ∈ r. x = fst p ∨ x = snd p})" by blast
obtain pt::"'U ⇒ 'U×'U" where p2: "pt = (λ x. (SOME p. p ∈ Pt x))" by blast
have "∀ x∈A. Pt x ≠ {}" using a4 unfolding p1 Field_def by force
then have p3: "∀ x∈A. pt x ∈ Pt x" unfolding p2 by (metis (full_types) Collect_empty_eq Collect_mem_eq someI_ex)
obtain D0 where b7: "D0 = Field s ∪ fst`(pt`A) ∪ snd`(pt`A)" by blast
obtain Di::"nat ⇒ 'U set" where b8: "Di = (λ n. (H^^n) D0)" by blast
obtain D::"'U set" where b9: "D = ⋃ {X. ∃ n. X = Di n}" by blast
obtain s' where b10: "s' = Restr r D" by blast
have b11: "∀ n. (¬ finite (Di n)) ∧ |Di n| ≤o |s|"
proof
fix n0
show "(¬ finite (Di n0)) ∧ |Di n0| ≤o |s|"
proof (induct n0)
have "|D0| =o |Field s|"
proof -
have "|fst`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c1: "|fst`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|snd`(pt`A)| ≤o |(pt`A)| ∧ |(pt`A)| ≤o |A|" by simp
then have c2: "|snd`(pt`A)| ≤o |A|" using ordLeq_transitive by blast
have "|fst`(pt`A)| ≤o |Field s| ∧ |snd`(pt`A)| ≤o |Field s|"
using c1 c2 a5 ordLeq_transitive by blast
moreover have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
ultimately have c3: "|D0| ≤o |Field s|" unfolding b7 by simp
have "Field s ⊆ D0" unfolding b7 by blast
then have "|Field s| ≤o |D0|" by simp
then show ?thesis using c3 ordIso_iff_ordLeq by blast
qed
moreover have "|Field s| =o |s|" using a3 lem_rel_inf_fld_card by blast
ultimately have "|D0| ≤o |s|" using ordIso_imp_ordLeq ordIso_transitive by blast
moreover have "¬ finite D0" using a3 b7 lem_fin_fl_rel by blast
ultimately show "¬ finite (Di 0) ∧ |Di 0| ≤o |s|" using b8 by simp
next
fix n
assume d1: "(¬ finite (Di n)) ∧ |Di n| ≤o |s|"
moreover then have "|(Di n) × (Di n)| =o |Di n|" by simp
ultimately have d2: "|(Di n) × (Di n)| ≤o |s|" using ordIso_imp_ordLeq ordLeq_transitive by blast
have d3: "∀ a ∈ (Di n). ∀ b ∈ (Di n). |Field (g {a, b})| ≤o |s|"
proof (intro ballI)
fix a b
assume "a ∈ (Di n)" and "b ∈ (Di n)"
have "finite (g {a, b})" using b3 b4 by (metis finite.emptyI)
then have "finite (Field (g {a, b}))" using lem_fin_fl_rel by blast
then have "|Field (g {a, b})| <o |s|" using a3 finite_ordLess_infinite2 by blast
then show "|Field (g {a, b})| ≤o |s|" using ordLess_imp_ordLeq by blast
qed
have d4: "Di (Suc n) = H (Di n)" using b8 by simp
then have "Di n ⊆ Di (Suc n)" using b5 by blast
then have "¬ finite (Di (Suc n))" using d1 finite_subset by blast
moreover have "|Di (Suc n)| ≤o |s|"
proof -
obtain I where e1: "I = (Di n) × (Di n)" by blast
obtain f where e2: "f = (λ (a,b). Field (g {a,b}))" by blast
have "|I| ≤o |s|" using e1 d2 by blast
moreover have "∀i∈I. |f i| ≤o |s|" using e1 e2 d3 by simp
ultimately have "|⋃ i∈I. f i| ≤o |s|" using a3 card_of_UNION_ordLeq_infinite[of s I f] by blast
moreover have "Di (Suc n) = (Di n) ∪ (⋃ i∈I. f i)
∪ (⋃ P∈Ps. (⋃ a∈(Di n). 𝔣 r a (q P a))) ∪ escl r A0 (Di n) ∪ (w`(Di n))"
using e1 e2 d4 b5 by blast
moreover have "|⋃ P∈Ps. (⋃ a∈(Di n). 𝔣 r a (q P a))| ≤o |s|"
proof -
have "⋀ P. P ∈ Ps ⟹ ∀a∈(Di n). |𝔣 r a (q P a)| ≤o |s|"
using a3 lem_ccext_ffin by (metis card_of_Well_order card_of_ordLeq_infinite ordLeq_total)
then have "⋀ P. P ∈ Ps ⟹ |⋃ a∈(Di n). 𝔣 r a (q P a)| ≤o |s|"
using d1 a3 card_of_UNION_ordLeq_infinite[of s "Di n" "λ a. 𝔣 r a (q _ a)"] by blast
moreover have "|Ps| ≤o |s|" using a3 a6 lem_rel_inf_fld_card[of s] lem_fin_fl_rel[of s]
by (metis ordIso_iff_ordLeq ordLeq_transitive)
ultimately show ?thesis
using a3 card_of_UNION_ordLeq_infinite[of s Ps "λ P. ⋃ a∈(Di n). 𝔣 r a (q P a)"] by blast
qed
moreover have "|escl r A0 (Di n)| ≤o |s|"
using d1 lem_escl_card[of "Di n" r A0] by (metis ordLeq_transitive)
moreover have "|w`(Di n)| ≤o |s|" using d1 using card_of_image ordLeq_transitive by blast
ultimately show ?thesis using d1 a3 by simp
qed
ultimately show "(¬ finite (Di (Suc n))) ∧ |Di (Suc n)| ≤o |s|" by blast
qed
qed
have b12: "∀ m. ∀ n. n ≤ m ⟶ Di n ≤ Di m"
proof
fix m0
show "∀ n. n ≤ m0 ⟶ Di n ≤ Di m0"
proof (induct m0)
show "∀n≤0. Di n ⊆ Di 0" by blast
next
fix m
assume d1: "∀n≤m. Di n ⊆ Di m"
show "∀n≤Suc m. Di n ⊆ Di (Suc m)"
proof (intro allI impI)
fix n
assume e1: "n ≤ Suc m"
have "Di (Suc m) = H (Di m)" using b8 by simp
moreover have "Di m ⊆ H (Di m)" using b5 by blast
ultimately have "n ≤ m ⟶ Di n ⊆ Di (Suc m)" using d1 by blast
moreover have "n = (Suc m) ∨ n ≤ m" using e1 by force
ultimately show "Di n ⊆ Di (Suc m)" by blast
qed
qed
qed
have "Di 0 ⊆ D" using b9 by blast
then have b13: "Field s ⊆ D" using b7 b8 by simp
then have b14: "s ⊆ s' ∧ s' ⊆ r" using a2 b10 unfolding Field_def by force
moreover have b15: "|D| ≤o |s|"
proof -
have "|UNIV::nat set| ≤o |s|" using a3 infinite_iff_card_of_nat by blast
then have "|⋃ n. Di n| ≤o |s|" using b11 a3 card_of_UNION_ordLeq_infinite[of s UNIV Di] by blast
moreover have "D = (⋃ n. Di n)" using b9 by force
ultimately show ?thesis by blast
qed
moreover have "|s'| =o |s|"
proof -
have "¬ finite (Field s)" using a3 lem_fin_fl_rel by blast
then have "¬ finite D" using b13 finite_subset by blast
then have "|D × D| =o |D|" by simp
moreover have "s' ⊆ D × D" using b10 by blast
ultimately have "|s'| ≤o |s|" using b15 card_of_mono1 ordLeq_ordIso_trans ordLeq_transitive by metis
moreover have "|s| ≤o |s'|" using b14 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
moreover have "A ⊆ Field s'"
proof
fix x
assume c1: "x ∈ A"
obtain ax bx where c2: "ax = fst (pt x) ∧ bx = snd (pt x)" by blast
have "pt x ∈ Pt x" using c1 p3 by blast
then have c3: "(ax, bx) ∈ r ∧ x ∈ {ax,bx}" using c2 p1 by simp
have "{ax, bx} ⊆ D0" using b7 c1 c2 by blast
moreover have "Di 0 ⊆ D" using b9 by blast
moreover have "Di 0 = D0" using b8 by simp
ultimately have "{ax, bx} ⊆ D" by blast
then have "(ax, bx) ∈ s'" using c3 b10 by blast
then show "x ∈ Field s'" using c3 unfolding Field_def by blast
qed
moreover have "CCR s'"
proof -
have "∀ a ∈ Field s'. ∀ b ∈ Field s'. ∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field s'" and d2: "b ∈ Field s'"
then have d3: "a ∈ D ∧ b ∈ D" using b10 unfolding Field_def by blast
then obtain ia ib where d4: "a ∈ Di ia ∧ b ∈ Di ib" using b9 by blast
obtain k where d5: "k = (max ia ib)" by blast
then have "ia ≤ k ∧ ib ≤ k" by simp
then have d6: "a ∈ Di k ∧ b ∈ Di k" using d4 b12 by blast
obtain p where d7: "p = g {a,b}" by blast
have "Field p ⊆ H (Di k)" using b5 d6 d7 by blast
moreover have "H (Di k) = Di (Suc k)" using b8 by simp
moreover have "Di (Suc k) ⊆ D" using b9 by blast
ultimately have d8: "Field p ⊆ D" by blast
have "{a, b} ⊆ Field r" using d1 d2 b10 unfolding Field_def by blast
moreover have "finite {a, b}" by simp
ultimately have d9: "CCR p ∧ p ⊆ r ∧ {a,b} ⊆ Field p" using d7 b3 by blast
then obtain c where d10: "c ∈ Field p ∧ (a,c) ∈ p^* ∧ (b,c) ∈ p^*" unfolding CCR_def by blast
have "(p `` D) ⊆ D" using d8 unfolding Field_def by blast
then have "D ∈ Inv p" unfolding Inv_def by blast
then have "p^* ∩ (D×(UNIV::'U set)) ⊆ (Restr p D)^*" using lem_Inv_restr_rtr[of D p] by blast
moreover have "Restr p D ⊆ s'" using d9 b10 by blast
moreover have "(a,c) ∈ p^* ∩ (D×(UNIV::'U set)) ∧ (b,c) ∈ p^* ∩ (D×(UNIV::'U set))" using d10 d3 by blast
ultimately have "(a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" using rtrancl_mono by blast
moreover then have "c ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃ c ∈ Field s'. (a,c) ∈ (s')^* ∧ (b,c) ∈ (s')^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
moreover have "∀ P∈Ps. (Field s' ∩ P) ∈ SCF s'"
proof -
have "∀ P ∈ Ps. ∀a∈Field s'. ∃b∈(Field s' ∩ P). (a, b) ∈ s'^*"
proof (intro ballI)
fix P a
assume d0: "P ∈ Ps" and d1: "a ∈ Field s'"
then have "a ∈ D" using b10 unfolding Field_def by blast
then obtain n where "a ∈ Di n" using b9 by blast
then have "𝔣 r a (q P a) ⊆ H (Di n)" using d0 b5 by blast
moreover have "H (Di n) = Di (Suc n)" using b8 by simp
ultimately have d2: "𝔣 r a (q P a) ⊆ D" using b9 by blast
have "a ∈ Field r" using d1 b10 unfolding Field_def by blast
then have "q P a ∈ P ∧ (a, q P a) ∈ r^*" using d0 q1 by blast
moreover have "Restr r (𝔣 r a (q P a)) ⊆ s'" using d0 d2 b10 by blast
ultimately have "q P a ∈ P ∧ (a, q P a) ∈ s'^*" using lem_Ccext_fint[of r a "q P a" s'] by blast
moreover then have "q P a ∈ Field s'" using d1 lem_rtr_field by metis
ultimately show "∃b∈(Field s' ∩ P). (a, b) ∈ s'^*" by blast
qed
then show ?thesis unfolding SCF_def by blast
qed
moreover have "escl r A0 (Field s') ⊆ Field s'"
proof
fix x
assume c1: "x ∈ escl r A0 (Field s')"
then obtain F a where c2: "x ∈ F ∧ F = dnesc r A0 a ∧ a ∈ Field s'" unfolding escl_def by blast
obtain n where "a ∈ Di n" using c2 b9 b10 unfolding Field_def by blast
then have "F ⊆ H (Di n)" using c2 b5 unfolding escl_def by blast
moreover have "H (Di n) = Di (Suc n)" using b8 b9 by simp
ultimately have c3: "F ⊆ D" using b9 by blast
show "x ∈ Field s'"
proof (cases "dnEsc r A0 a = {}")
assume "dnEsc r A0 a = {}"
then have "x = a" using c2 lem_dnEsc_emp[of r A0] by blast
then show ?thesis using c2 by blast
next
assume "dnEsc r A0 a ≠ {}"
then have "F ∈ dnEsc r A0 a" using c2 lem_dnEsc_ne[of r A0 a] by blast
then obtain b where "F ∈ ℱ r a b" unfolding dnEsc_def by blast
then obtain f k where "f ∈ rpth r a b k ∧ F = f`{i. i≤k}" unfolding ℱ_def by blast
moreover then obtain j where "j≤k ∧ x = f j" using c2 by blast
ultimately have "f ∈ rpth (Restr r D) a x j" using c3 unfolding rpth_def by force
then have "a ∈ Field s' ∧ (a,x) ∈ s'^*" using c2 b10 lem_ccext_rpth_rtr[of _ a x] by blast
then show ?thesis using lem_rtr_field by metis
qed
qed
moreover have "∃ D. s' = Restr r D" using b10 by blast
moreover have "¬ Conelike r ⟶ ¬ Conelike s'"
proof
assume "¬ Conelike r"
then have c1: "∀ a ∈ Field r. Field r - dncl r {a} ≠ {}" unfolding Conelike_def dncl_def by blast
have "∀ a ∈ Field s'. ∃ a' ∈ Field s'. (a', a) ∉ s'^*"
proof
fix a
assume d1: "a ∈ Field s'"
then have d2: "a ∈ Field r" using b10 unfolding Field_def by blast
then have d3: "w a ∈ Field r - dncl r {a}" using c1 w1 by blast
then have "(w a, a) ∉ s'^*" unfolding dncl_def using b10 rtrancl_mono[of s' r] by blast
moreover have "w a ∈ Field s'"
proof -
obtain n where "a ∈ Di n" using d1 b9 b10 unfolding Field_def by blast
then have "a ∈ Di (Suc n) ∧ w a ∈ Di (Suc n)" using b5 b8 by simp
then have e1: "Field (g {a, w a}) ⊆ H (Di (Suc n))" using b5 b8 by blast
have e2: "{a, w a} ⊆ Field r ∧ finite {a, w a}" using d2 d3 by blast
have "H (Di (Suc n)) = Di (Suc (Suc n))" using b8 by simp
moreover have "Di (Suc (Suc n)) ⊆ D" using b9 by blast
ultimately have "Field (g {a,w a}) ⊆ D" using e1 by blast
moreover have "Restr (g {a,w a}) D ⊆ s'" using e2 b3 b10 by blast
ultimately have "g {a,w a} ⊆ s'" unfolding Field_def by fastforce
moreover have "w a ∈ Field (g {a, w a})" using e2 b3 by blast
ultimately show "w a ∈ Field s'" unfolding Field_def by blast
qed
ultimately show "∃ a' ∈ Field s'. (a', a) ∉ s'^*" by blast
qed
moreover have "s' ≠ {}" using b14 a3 by force
ultimately show "¬ Conelike s'" unfolding Conelike_def by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_infsubccr_pext5_scf3:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set"
assumes a1: "CCR r" and a2: "¬ finite A" and a3: "A ∈ SF r" and a4: "Ps ⊆ SCF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A|
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' ⊆ {y}) ⟶ Field r ⊆ (A'∪B'))
∧ ( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )
∧ (escl r A A' ⊆ A') ∧ clterm (Restr r A') r"
proof -
obtain Ps' where p0: "Ps' = (if ( |Ps| ≤o |A| ) then Ps else {})" by blast
then have p1: "Ps' ⊆ SCF r ∧ |Ps'| ≤o |A|" using a4 by simp
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "¬ finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B' ⊆ {y})) ⟶ y1 ∉ B' ∧ y2 ∉ B' ∧ y1 ≠ y2" by blast
obtain y3 where n3: "(¬ (Field r - B' ⊆ {})) ⟶ y3 ∈ Field r - B'" by blast
obtain A1 where b4: "A1 = ({x, y1, y2, y3} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "|A1| ≤o |Field s|"
proof -
obtain C1 where c1: "C1 = {x,y1,y2,y3} ∩ Field r" by blast
obtain C2 where c2: "C2 = A ∪ f ` A" by blast
have "¬ finite A" using q4 q3 lem_fin_fl_rel by blast
then have "|C2| =o |A|" using c2 b4 q3 by simp
then have "|C2| ≤o |Field s|" unfolding q4 using ordIso_iff_ordLeq by blast
moreover have c3: "¬ finite (Field s)" using q3 lem_fin_fl_rel by blast
moreover have "|C1| ≤o |Field s|"
proof -
have "|{x,y1,y2,y3}| ≤o |Field s|" using c3
by (meson card_of_Well_order card_of_ordLeq_finite finite.emptyI finite.insertI ordLeq_total)
moreover have "|C1| ≤o |{x,y1,y2,y3}|" unfolding c1 by simp
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately have "|C1 ∪ C2| ≤o |Field s|" unfolding b4 using card_of_Un_ordLeq_infinite by blast
moreover have "A1 = C1 ∪ C2" using c1 c2 b4 by blast
ultimately show ?thesis by blast
qed
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ |s'| =o |s| ∧ A1 ⊆ Field s'"
and s1': "(∀ P ∈ Ps'. (Field s' ∩ P) ∈ SCF s')"
and s1'': "escl r A (Field s') ⊆ Field s'"
and s1''': "(∃ D. s' = Restr r D) ∧ (Conelike s' ⟶ Conelike r)"
using p1 a1 q2 q3 q4 lem_Ccext_infsubccr_set_ext_scf3[of r s A1 Ps' A] by blast
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "|Field s'| =o |Field s|" using s1 q3 lem_cardreleq_cardfldeq_inf[of s' s] by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
moreover have "|A'| =o |A1|"
proof -
have "Field s ⊆ A1" using q4 b4 by blast
then have "|Field s| ≤o |A1|" by simp
then have "|A'| ≤o |A1|" using s2 s5 ordIso_ordLeq_trans by blast
moreover have "|A1| ≤o |A'|" using s1 s2 by simp
ultimately show ?thesis using ordIso_iff_ordLeq by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A') ∧ |A'| =o |A1|" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
moreover have "|A'| =o |A|" using s5 s2 q4 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B' ⊆ {y}) ⟶ Field r ⊆ (A' ∪ B')"
proof
assume c0: "∃ y::'U. A' - B' ⊆ {y}"
show "Field r ⊆ (A' ∪ B')"
proof (cases "∃ y::'U. A' - B' = {y}")
assume c1: "∃ y::'U. A' - B' = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B' ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B' ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B' ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B' ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
next
assume "¬ (∃ y::'U. A' - B' = {y})"
then have c1: "A' - B' = {}" using c0 by blast
show "Field r ⊆ (A' ∪ B')"
proof (cases "Field r = {}")
assume "Field r = {}"
then show "Field r ⊆ (A' ∪ B')" by blast
next
assume "Field r ≠ {}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ Field r" using n3 by blast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ A' - B' " using n3 by blast
moreover have "¬ ({y3} ⊆ A' - B' )" using c1 by force
ultimately have "Field r - B' ⊆ {}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
qed
qed
qed
moreover have "( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
proof -
have c1: "s' ⊆ r" using s3 s4 by blast
then have "Field s' = Field (Restr r (Field s'))" using lem_Relprop_fld_sat by blast
moreover have "s' ⊆ Restr r (Field s')" using c1 unfolding Field_def by force
ultimately have "SCF s' ⊆ SCF (Restr r (Field s'))" using lem_ccext_scf_sat[of s' "Restr r (Field s')"] by blast
moreover have "|Ps| ≤o |A| ⟶ Ps' = Ps" using p0 by simp
ultimately show ?thesis using s1' s2 by blast
qed
moreover have "escl r A A' ⊆ A'" using s1'' s2 by blast
moreover have "Conelike (Restr r A') ⟶ Conelike r"
proof
assume c1: "Conelike (Restr r A')"
obtain D where "s' = Restr r D" using s1''' by blast
then have "s' = Restr r (Field s')" unfolding Field_def by force
then have "Conelike s'" using c1 s2 by simp
then show "Conelike r" using s1''' by blast
qed
ultimately show ?thesis unfolding clterm_def by blast
qed
lemma lem_Ccext_finsubccr_pext5_scf3:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set"
assumes a1: "CCR r" and a2: "finite A" and a3: "A ∈ SF r" and a4: "Ps ⊆ SCF r"
shows "∃ A'::('U set). (x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A') ∧ finite A'
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' ⊆ {y}) ⟶ Field r ⊆ (A'∪B'))
∧ ((∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
proof -
obtain P where p0: "P = (if (Ps ≠ {}) then (SOME P. P ∈ Ps) else Field r)" by blast
moreover have "Field r ∈ SCF r" unfolding SCF_def by blast
ultimately have p1: "P ∈ SCF r" using a4 by (metis contra_subsetD some_in_eq)
have p2: "(∃ P. Ps = {P}) ⟶ Ps = {P}" using p0 by fastforce
have q1: "Field (Restr r A) = A" using a3 unfolding SF_def by blast
obtain s where "s = (Restr r A)" by blast
then have q2: "s ⊆ r" and q3: "finite s" and q4: "A = Field s"
using a2 q1 lem_fin_fl_rel by (blast, metis, blast)
obtain S where b1: "S = (λ a. r``{a} - B )" by blast
obtain S' where b2: "S' = (λ a. if (S a) ≠ {} then (S a) else {a})" by blast
obtain f where "f = (λ a. SOME b. b ∈ S' a)" by blast
moreover have "∀ a. ∃ b. b ∈ (S' a)" unfolding b2 by force
ultimately have "∀ a. f a ∈ S' a" by (metis someI_ex)
then have b3: "∀ a. (S a ≠ {} ⟶ f a ∈ S a) ∧ (S a = {} ⟶ f a = a)"
unfolding b2 by (clarsimp, metis singletonD)
obtain y1 y2::'U where n1: "Field r ≠ {} ⟶ {y1, y2} ⊆ Field r"
and n2: "(¬ (∃ y::'U. Field r - B' ⊆ {y})) ⟶ y1 ∉ B' ∧ y2 ∉ B' ∧ y1 ≠ y2" by blast
obtain y3 where n3: "(¬ (Field r - B' ⊆ {})) ⟶ y3 ∈ Field r - B'" by blast
obtain A1 where b4: "A1 = ({x,y1,y2,y3} ∩ Field r) ∪ A ∪ (f ` A)" by blast
have "A1 ⊆ Field r"
proof -
have c1: "A ⊆ Field r" using q4 q2 unfolding Field_def by blast
moreover have "f ` A ⊆ Field r"
proof
fix x
assume "x ∈ f ` A"
then obtain a where d2: "a ∈ A ∧ x = f a" by blast
show "x ∈ Field r"
proof (cases "S a = {}")
assume "S a = {}"
then have "x = a" using c1 d2 b3 by blast
then show "x ∈ Field r" using d2 c1 by blast
next
assume "S a ≠ {}"
then have "x ∈ S a" using d2 b3 by blast
then show "x ∈ Field r" using b1 unfolding Field_def by blast
qed
qed
ultimately show "A1 ⊆ Field r" using b4 by blast
qed
moreover have s0: "finite A1" using b4 q3 q4 lem_fin_fl_rel by blast
ultimately obtain s' where s1: "CCR s' ∧ s ⊆ s' ∧ s' ⊆ r ∧ finite s' ∧ A1 ⊆ Field s'"
and s1': "(∃ P. Ps = {P}) ⟶ (Field s' ∩ P) ∈ SCF s'"
using p1 a1 a4 q2 q3 lem_Ccext_finsubccr_set_ext_scf[of r s A1 P] by metis
obtain A' where s2: "A' = Field s'" by blast
obtain s'' where s3: "s'' = Restr r A'" by blast
then have s4: "s' ⊆ s'' ∧ Field s'' = A'" using s1 s2 lem_Relprop_fld_sat[of s' r s''] by blast
have s5: "finite (Field s')" using s1 lem_fin_fl_rel by blast
have "A1 ∪ ({x} ∩ Field r) ⊆ A'" using b4 s1 s2 by blast
moreover have "CCR (Restr r A')"
proof -
have "CCR s''" using s1 s2 s4 lem_Ccext_subccr_eqfld[of s' s''] by blast
then show ?thesis using s3 by blast
qed
ultimately have b6: "A1 ∪ ({x} ∩ Field r) ⊆ A' ∧ CCR (Restr r A')" by blast
moreover then have "A ∪ ({x} ∩ Field r) ⊆ A'" using b4 by blast
ultimately have "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')" by blast
moreover have "finite A'" using s2 s5 by blast
moreover have "∀a∈A. r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}"
proof
fix a
assume c1: "a ∈ A"
have "¬ (r``{a} ⊆ B) ⟶ r``{a} ∩ (A'-B) ≠ {}"
proof
assume "¬ (r``{a} ⊆ B)"
then have "S a ≠ {}" unfolding b1 by blast
then have "f a ∈ r``{a} - B" using b1 b3 by blast
moreover have "f a ∈ A'" using c1 b4 b6 by blast
ultimately show "r``{a} ∩ (A'-B) ≠ {}" by blast
qed
then show "r``{a} ⊆ B ∨ r``{a} ∩ (A'-B) ≠ {}" by blast
qed
moreover have "A' ∈ SF r" using s3 s4 unfolding SF_def by blast
moreover have "(∃ y::'U. A' - B' ⊆ {y}) ⟶ Field r ⊆ (A' ∪ B')"
proof
assume c0: "∃ y::'U. A' - B' ⊆ {y}"
show "Field r ⊆ (A' ∪ B')"
proof (cases "∃ y::'U. A' - B' = {y}")
assume c1: "∃ y::'U. A' - B' = {y}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "{y1, y2} ⊆ Field r" using n1 by blast
then have "{y1, y2} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (∃y. Field r - B' ⊆ {y}) ⟶ {y1, y2} ⊆ A' - B' ∧ y1 ≠ y2" using n2 by blast
moreover have "¬ ({y1, y2} ⊆ A' - B' ∧ y1 ≠ y2)" using c1 by force
ultimately have "∃ y::'U. Field r - B' ⊆ {y}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
next
assume "¬ (∃ y::'U. A' - B' = {y})"
then have c1: "A' - B' = {}" using c0 by blast
show "Field r ⊆ (A' ∪ B')"
proof (cases "Field r = {}")
assume "Field r = {}"
then show "Field r ⊆ (A' ∪ B')" by blast
next
assume "Field r ≠ {}"
moreover have c2: "A' ⊆ Field r" using s1 s2 unfolding Field_def by blast
ultimately have "Field r ≠ {}" by blast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ Field r" using n3 by blast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ A'" using b4 s1 s2 by fast
then have "¬ (Field r - B' ⊆ {}) ⟶ {y3} ⊆ A' - B' " using n3 by blast
moreover have "¬ ({y3} ⊆ A' - B' )" using c1 by force
ultimately have "Field r - B' ⊆ {}" by blast
then show "Field r ⊆ A' ∪ B'" using c1 c2 by blast
qed
qed
qed
moreover have "(∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A'))"
proof -
have c1: "s' ⊆ r" using s3 s4 by blast
then have "Field s' = Field (Restr r (Field s'))" using lem_Relprop_fld_sat by blast
moreover have "s' ⊆ Restr r (Field s')" using c1 unfolding Field_def by force
ultimately have "SCF s' ⊆ SCF (Restr r (Field s'))" using lem_ccext_scf_sat[of s' "Restr r (Field s')"] by blast
then show ?thesis using p2 s1' s2 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Ccext_subccr_pext5_scf3:
fixes r::"'U rel" and A B B'::"'U set" and x::'U and Ps::"'U set set" and C::"'U set ⇒ bool"
assumes a1: "CCR r" and a2: "A ∈ SF r" and a3: "Ps ⊆ SCF r"
and a4: "C = (λ A'::'U set. (x ∈ Field r ⟶ x ∈ A')
∧ A ⊆ A'
∧ A' ∈ SF r
∧ (∀a∈A. ((r``{a}⊆B) ∨ (r``{a}∩(A'-B) ≠ {})))
∧ ((∃ y::'U. A'-B' ⊆ {y}) ⟶ Field r ⊆ (A'∪B'))
∧ CCR (Restr r A')
∧ ((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))
∧ ( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶
(∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))
∧ ( (¬ finite A) ⟶ ((escl r A A' ⊆ A') ∧ (clterm (Restr r A') r))) )"
shows "∃ A'::('U set). C A'"
proof (cases "finite A")
assume b1: "finite A"
then obtain A'::"'U set" where b2: "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' ⊆ {y}) ⟶ Field r ⊆ (A'∪B'))"
and b3: "finite A' ∧ ((∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using a1 a2 a3 lem_Ccext_finsubccr_pext5_scf3[of r A Ps x B B'] by metis
have b4: "((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))"
and b5: "( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using b1 b3 card_of_ordLeq_finite by blast+
show ?thesis
apply (rule exI)
unfolding a4 using b1 b2 b4 b5 by force
next
assume b1: "¬ finite A"
then obtain A' where b2: "(x ∈ Field r ⟶ x ∈ A') ∧ A ⊆ A' ∧ CCR (Restr r A')
∧ (∀a∈A. r``{a}⊆B ∨ r``{a}∩(A'-B) ≠ {}) ∧ A' ∈ SF r
∧ ((∃ y::'U. A'-B' ⊆ {y}) ⟶ Field r ⊆ (A'∪B'))"
and b3: "|A'| =o |A| ∧ ( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
and b3': "(escl r A A' ⊆ A') ∧ clterm (Restr r A') r"
using a1 a2 a3 lem_Ccext_infsubccr_pext5_scf3[of r A Ps x B B'] by metis
have b4: "((finite A ⟶ finite A') ∧ ( (¬ finite A) ⟶ |A'| =o |A| ))"
using b1 b3 by metis
have b5: "( ((∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| )) ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')))"
using b1 b3 by (metis card_of_singl_ordLeq finite.simps)
have b6: "( (¬ finite A) ⟶ ((escl r A A' ⊆ A') ∧ clterm (Restr r A') r))" using b3' by blast
have "C A'" unfolding a4 using b2 b4 b5 b6 by simp
then show ?thesis by blast
qed
lemma lem_acyc_un_emprd:
fixes r s:: "'U rel"
assumes a1: "acyclic r ∧ acyclic s" and a2: "(Range r) ∩ (Domain s) = {}"
shows "acyclic (r ∪ s)"
proof -
have "⋀ n. (r ∪ s)^^n ⊆ s^* O r^*"
proof -
fix n
show "(r ∪ s)^^n ⊆ s^* O r^*"
proof (induct n)
show "(r ∪ s)^^0 ⊆ s^* O r^*" by force
next
fix n
assume "(r ∪ s)^^n ⊆ s^* O r^*"
moreover then have "(r ∪ s)^^n O r ⊆ s^* O r^*" by force
moreover have "(s^* O r^*) O s ⊆ s^* O r^*"
proof -
have "r^+ O s = r^* O (r O s)" by (simp add: O_assoc trancl_unfold_right)
moreover have "r O s = {}" using a2 by force
ultimately have "s^* O (r^+ O s) = {}" by force
moreover have "s^* O s ⊆ s^*" by force
moreover have "r^* = Id ∪ r^+" by (metis rtrancl_unfold trancl_unfold_right)
moreover then have "(s^* O r^*) O s = (s^* O s) ∪ (s^* O (r^+ O s))" by fastforce
ultimately show ?thesis by fastforce
qed
moreover have "(r ∪ s)^^(Suc n) = ((((r ∪ s)^^n) O r) ∪ (((r ∪ s)^^n) O s))" by simp
ultimately show "(r ∪ s) ^^ (Suc n) ⊆ s^* O r^*" by force
qed
qed
then have b1: "(r ∪ s)^* ⊆ s^* O r^*" using rtrancl_power[of _ "r ∪ s"] by blast
have "∀x. (x,x) ∈ (r ∪ s)^+ ⟶ False"
proof (intro allI impI)
fix x
assume "(x,x) ∈ (r ∪ s)^+"
then have "(x,x) ∈ (r ∪ s)^* O (r ∪ s)" using trancl_unfold_right by blast
then have "(x,x) ∈ ((s^* O r^*) O r) ∪ ((s^* O r^*) O s)" using b1 by force
moreover have "(x,x) ∈ ((s^* O r^*) O r) ⟶ False"
proof
assume "(x,x) ∈ ((s^* O r^*) O r)"
then obtain u v where d1: "(x,u) ∈ s^* ∧ (u,v) ∈ r^* ∧ (v,x) ∈ r" by blast
moreover then have "x ∉ Domain s" using a2 by blast
ultimately have "x = u" by (meson Not_Domain_rtrancl)
then have "(x,x) ∈ r^+" using d1 by force
then show "False" using a1 unfolding acyclic_def by blast
qed
moreover have "(x,x) ∈ ((s^* O r^*) O s) ⟶ False"
proof
assume "(x,x) ∈ ((s^* O r^*) O s)"
then obtain u v where d1: "(x,u) ∈ s^* ∧ (u,v) ∈ r^* ∧ (v,x) ∈ s" by blast
have "u = v ⟶ False"
proof
assume "u = v"
then have "(x,x) ∈ s^+" using d1 by force
then show "False" using a1 unfolding acyclic_def by blast
qed
then have "(u,v) ∈ r^+" using d1 by (meson rtranclD)
then have "v ∈ Range r" using trancl_unfold_right[of r] by force
moreover have "v ∈ Domain s" using d1 by blast
ultimately show "False" using a2 by blast
qed
ultimately show "False" by blast
qed
then show ?thesis using a1 unfolding acyclic_def by blast
qed
lemma lem_spthlen_rtr: "(a,b) ∈ r^* ⟹ (a,b) ∈ r^^(spthlen r a b)"
using rtrancl_power unfolding spthlen_def by (metis LeastI_ex)
lemma lem_spthlen_tr: "(a,b) ∈ r^* ∧ a ≠ b ⟹ (a,b) ∈ r^^(spthlen r a b) ∧ spthlen r a b > 0"
proof -
assume "(a,b) ∈ r^* ∧ a ≠ b"
moreover then have b1: "(a,b) ∈ r^^(spthlen r a b)" using lem_spthlen_rtr[of a b] by force
ultimately have "spthlen r a b = 0 ⟶ False" by force
then show ?thesis using b1 by blast
qed
lemma lem_spthlen_min: "(a,b) ∈ r^^n ⟹ spthlen r a b ≤ n"
unfolding spthlen_def by (metis Least_le)
lemma lem_spth_inj:
fixes r::"'U rel" and a b::"'U" and f::"nat ⇒ 'U" and n::"nat"
assumes a1: "f ∈ spth r a b" and a2: "n = spthlen r a b"
shows "inj_on f {i. i≤n}"
proof -
have b1: "f ∈ rpth r a b n" using a1 a2 unfolding spth_def by blast
have "∀ i j. i ≤ n ∧ j ≤ n ∧ i < j ⟶ f i = f j ⟶ False"
proof (intro allI impI)
fix i j
assume c1: "i ≤ n ∧ j ≤ n ∧ i < j" and c2: "f i = f j"
obtain l where c3: "l = j - i" by blast
then have c4: "l ≠ 0" using c1 by simp
obtain g where c5: "g = (λ k. if (k≤i) then (f k) else (f (k + l)))" by blast
then have "g 0 = a" using b1 unfolding rpth_def by fastforce
moreover have "g (n - l) = b"
proof (cases "j < n")
assume "j < n"
then show ?thesis using c5 c3 b1 unfolding rpth_def by simp
next
assume "¬ j < n"
then have "j = n" using c1 by simp
then show ?thesis using c5 c2 c3 c4 b1 unfolding rpth_def by simp
qed
moreover have "∀ k < n - l. (g k, g (Suc k)) ∈ r"
proof (intro allI impI)
fix k
assume d1: "k < n - l"
have "k ≠ i ⟶ (g k, g (Suc k)) ∈ r" using c5 d1 b1 unfolding rpth_def by fastforce
moreover have "k = i ⟶ (g k, g (Suc k)) ∈ r"
proof
assume e1: "k = i"
then have "(g k, g (Suc k)) = (f i, f ((Suc i) + l))" using c5 by simp
moreover have "f i = f (i + l)" using c1 c2 c3 by simp
moreover have "i + l < n" using d1 e1 by force
ultimately show "(g k, g (Suc k)) ∈ r" using b1 unfolding rpth_def by simp
qed
ultimately show "(g k, g (Suc k)) ∈ r" by force
qed
ultimately have "g ∈ rpth r a b (n - l)" unfolding rpth_def by blast
then have "spthlen r a b ≤ n - l"
using lem_spthlen_min[of a b] lem_ccext_ntr_rpth[of a b] by blast
then show "False" using a2 c1 c3 by force
qed
moreover then have "∀ i j. i ≤ n ∧ j ≤ n ∧ j < i ⟶ f i = f j ⟶ False" by metis
ultimately show ?thesis unfolding inj_on_def by (metis linorder_neqE_nat mem_Collect_eq)
qed
lemma lem_rtn_rpth_inj: "(a,b) ∈ r^^n ⟹ n = spthlen r a b ⟹ ∃ f . f ∈ rpth r a b n ∧ inj_on f {i. i ≤ n}"
proof -
assume a1: "(a,b) ∈ r^^n" and a2: "n = spthlen r a b"
then have "(a,b) ∈ r^^n" using lem_spthlen_rtr[of a b] rtrancl_power by blast
then obtain f where b2: "f ∈ rpth r a b n" using lem_ccext_ntr_rpth[of a b] by blast
then have "f ∈ spth r a b" using a2 unfolding spth_def by blast
then have "inj_on f {i. i ≤ n}" using a2 lem_spth_inj[of f] by blast
then show ?thesis using b2 by blast
qed
lemma lem_rtr_rpth_inj: "(a,b) ∈ r^* ⟹ ∃ f n . f ∈ rpth r a b n ∧ inj_on f {i. i ≤ n}"
using lem_spthlen_rtr[of a b r] lem_rtn_rpth_inj[of a b _ r] by blast
lemma lem_sum_ind_ex:
assumes a1: "g = (λn::nat. ∑i<n. f i)"
and a2:"∀i::nat. f i > 0"
shows "∃ n k. (m::nat) = g n + k ∧ k < f n"
proof(induct m)
have "0 = g 0 + 0 ∧ 0 < f 0" using a1 a2 by simp
then show "∃n k. (0::nat) = g n + k ∧ k < f n" by blast
next
fix m
assume "∃n k. m = g n + k ∧ k < f n"
then obtain n k where b1: "m = g n + k ∧ k < f n" by blast
show "∃n' k'. Suc m = g n' + k' ∧ k' < f n'"
proof(cases "Suc k < f n")
assume "Suc k < f n"
then have "Suc m = g n + (Suc k) ∧ (Suc k) < f n" using b1 by simp
then show "∃n' k'. Suc m = g n' + k' ∧ k' < f n'" by blast
next
assume "¬ Suc k < f n"
then have "Suc m = g (Suc n) + 0 ∧ 0 < f (Suc n)" using a1 a2 b1 by simp
then show "∃n' k'. Suc m = g n' + k' ∧ k' < f n'" by blast
qed
qed
lemma lem_sum_ind_un:
assumes a1: "g = (λn::nat. ∑i<n. f i)"
and a2: "∀i::nat. f i > 0"
and a3: "(m::nat) = g n + k ∧ k < f n"
and a4: "m = g n' + k' ∧ k' < f n'"
shows "n = n' ∧ k = k'"
proof -
have b1: "∀ n1 n2. n1 ≤ n2 ⟶ g n1 ≤ g n2"
proof(intro allI impI)
fix n1::nat and n2::nat
assume "n1 ≤ n2"
moreover obtain t where "t = n2 - n1" by blast
moreover have "g n1 ≤ g (n1 + t)" unfolding a1 by (induct t, simp+)
ultimately show "g n1 ≤ g n2" by simp
qed
have "n < n' ⟶ False"
proof
assume "n < n'"
then have "g (Suc n) ≤ g n'" using b1 by simp
then have "g n + f n ≤ g n'" using a1 b1 by simp
moreover have "g n' < g n + f n" using a3 a4 by simp
ultimately show "False" by simp
qed
moreover have "n' < n ⟶ False"
proof
assume "n' < n"
then have "g (Suc n') ≤ g n" using b1 by simp
then have "g n' + f n' ≤ g n" using a1 b1 by simp
moreover have "g n < g n' + f n'" using a3 a4 by simp
ultimately show "False" by simp
qed
ultimately show "n = n' ∧ k = k'" using a3 a4 by simp
qed
lemma lem_flatseq:
fixes r::"'U rel" and xi::"nat ⇒ 'U"
assumes "∀n. (xi n, xi (Suc n)) ∈ r^* ∧ (xi n ≠ xi (Suc n))"
shows "∃ g yi. ( ∀n. (yi n, yi (Suc n)) ∈ r )
∧ (∀ i::nat. ∀ j::nat. i < j ⟷ g i < g j )
∧ (∀ i::nat. yi (g i) = xi i)
∧ (∀ i::nat. inj_on yi { k. g i ≤ k ∧ k ≤ g (Suc i) } )
∧ (∀ k::nat. ∃ i::nat. g i ≤ k ∧ Suc k ≤ g (Suc i))
∧ (∀ k i i'. g i ≤ k ∧ Suc k ≤ g (Suc i) ∧ g i' ≤ k ∧ Suc k ≤ g (Suc i') ⟶ i = i' )"
proof -
obtain P where b0: "P = (λ n m. m > 0 ∧ (xi n, xi (Suc n)) ∈ r^^m ∧ m = spthlen r (xi n) (xi (Suc n)))" by blast
then have "∀n. ∃m. P n m" using assms lem_spthlen_tr[of _ _ r] by blast
then obtain f where "∀n. P n (f n)" by metis
then have b1: "∀ n. (f n) > 0 ∧ (xi n, xi (Suc n)) ∈ r^^(f n)"
and b1': "∀ n. (f n) = spthlen r (xi n) (xi (Suc n))" using b0 by blast+
have "∀ n. ∃yi. inj_on yi {i. i ≤ f n} ∧ (yi 0) = (xi n) ∧
(∀k<(f n). (yi k, yi (Suc k)) ∈ r) ∧ (yi (f n)) = (xi (Suc n))"
proof
fix n
have "(xi n, xi (Suc n)) ∈ r^^(f n)" and "(f n) = spthlen r (xi n) (xi (Suc n))"
using b1 b1' by blast+
then obtain yi where "yi ∈ rpth r (xi n) (xi (Suc n)) (f n) ∧ inj_on yi {i. i ≤ f n}"
using lem_rtn_rpth_inj[of "xi n" "xi (Suc n)" "f n" r] by blast
then show "∃yi. inj_on yi {i. i ≤ f n} ∧ (yi 0) = (xi n) ∧ (∀k<(f n). (yi k, yi (Suc k)) ∈ r)
∧ (yi (f n)) = (xi (Suc n)) " unfolding rpth_def by blast
qed
then obtain yin where b2: "∀ n. inj_on (yin n) {i. i ≤ f n} ∧ ((yin n) 0) = (xi n) ∧
(∀k < (f n). ((yin n) k, (yin n) (Suc k)) ∈ r) ∧ ((yin n) (f n)) = (xi (Suc n))" by metis
obtain g where b3: "g = (λn. ∑i<n. f i)" by blast
obtain yi where b4: "yi = (λm. let p =
(SOME p. m = (g (fst p)) + (snd p) ∧ (snd p) < (f (fst p)))
in (yin (fst p)) (snd p) )" by blast
have b5: "⋀ m n k. m = (g n) + k ∧ k < f n ⟹ yi m = yin n k"
proof -
fix m n k
assume c0: "m = (g n) + k ∧ k < f n"
have "∃ p . (m = (g (fst p)) + (snd p)) ∧ ((snd p) < (f (fst p)))"
using b1 b3 lem_sum_ind_ex by force
then obtain n' k' where "m = (g n') + k' ∧ k' < (f n') ∧ yi m = (yin n') k'"
using b4 by (smt someI_ex)
moreover then have "n' = n ∧ k' = k" using c0 b1 b3 lem_sum_ind_un[of g f m n' k' n k] by blast
ultimately show "yi m = yin n k" by blast
qed
have "∀m. (yi m, yi (Suc m)) ∈ r"
proof
fix m
have "∃ p . (m = (g (fst p)) + (snd p)) ∧ ((snd p) < (f (fst p)))"
using b1 b3 lem_sum_ind_ex by force
then obtain n k where c1: "m = (g n) + k ∧ k < (f n) ∧ yi m = (yin n) k"
using b4 by (smt someI_ex)
have "∃ p . ((Suc m) = (g (fst p)) + (snd p)) ∧ ((snd p) < (f (fst p)))"
using b1 b3 lem_sum_ind_ex by force
then obtain n' k' where c2: "(Suc m) = (g n') + k' ∧ k' < (f n') ∧ yi (Suc m) = (yin n') k'"
using b4 by (smt someI_ex)
show "(yi m, yi (Suc m)) ∈ r"
proof(cases "Suc k < f n")
assume "Suc k < f n"
then have "Suc m = g n + (Suc k) ∧ (Suc k) < f n" using c1 by simp
then have "n' = n ∧ k' = Suc k" using b1 b3 c2 lem_sum_ind_un[of g] by blast
then show "(yi m, yi (Suc m)) ∈ r" using b2 c1 c2 by force
next
assume d1: "¬ Suc k < f n"
then have "Suc m = g (Suc n) + 0 ∧ 0 < f (Suc n)" using b1 b3 c1 by simp
then have "n' = Suc n ∧ k' = 0" using b1 b3 c2 lem_sum_ind_un[of g] by blast
then show "(yi m, yi (Suc m)) ∈ r"
using b2 c1 c2 d1 by (metis Suc_le_eq dual_order.antisym not_less)
qed
qed
moreover have b6: "∀ j::nat. ∀ i::nat. i < j ⟶ g i < g j"
proof
fix j0::"nat"
show "∀ i::nat. i < j0 ⟶ g i < g j0"
proof (induct j0)
show "∀i<0. g i < g 0" by blast
next
fix j::"nat"
assume d1: "∀i<j. g i < g j"
show "∀i<Suc j. g i < g (Suc j)"
proof (intro allI impI)
fix i::"nat"
assume "i < Suc j"
then have "i ≤ j" by force
moreover have "g j < g (Suc j)" using b1 b3 by simp
moreover then have "i < j ⟶ g i < g (Suc j)" using d1 by force
ultimately show "g i < g (Suc j)" by force
qed
qed
qed
moreover have b7: "∀ j::nat. ∀i::nat. j ≤ i ⟶ g j ≤ g i"
proof (intro allI impI)
fix j::"nat" and i::"nat"
assume "j ≤ i"
moreover have "j < i ⟶ g j ≤ g i" using b6 by force
moreover have "j = i ⟶ g j ≤ g i" by blast
ultimately show "g j ≤ g i" by force
qed
moreover have b8: "∀ j::nat. ∀ i::nat. g i < g j ⟶ i < j"
proof (intro allI impI)
fix j::"nat" and i::"nat"
assume "g i < g j"
moreover have "j ≤ i ⟶ g j ≤ g i" using b7 by blast
ultimately show "i < j" by simp
qed
moreover have b9: "∀ i::nat. yi (g i) = xi i"
proof
fix i::"nat"
obtain p where "p = (i, 0::nat)" by blast
then have "((g i) = (g (fst p)) + (snd p)) ∧ ((snd p) < (f (fst p)))" using b1 by force
then obtain n k where c1: "(g i) = (g n) + k ∧ k < (f n) ∧ yi (g i) = (yin n) k"
using b4 by (smt someI_ex)
then have "g n ≤ g i" by simp
moreover have "g n < g i ⟶ False"
proof
assume "g n < g i"
then have "n < i" using b8 by blast
then have "g (Suc n) ≤ g i" using b7 by simp
then show "False" using c1 b3 b6 by force
qed
ultimately have "g i = g n" by force
then have "¬ i < n ∧ ¬ n < i" using b6 by force
then have "i = n ∧ k = 0" using c1 by force
then have "yi (g i) = (yin i) 0" using c1 by blast
moreover have "(yin i) 0 = xi i" using b2 by blast
ultimately show "yi (g i) = xi i" by simp
qed
moreover have "∀ i::nat. inj_on yi { k. g i ≤ k ∧ k ≤ g (Suc i) }"
proof
fix i
have c1: "inj_on (yin i) {k. k ≤ f i}" using b2 by blast
have "∀ k1 k2. g i ≤ k1 ∧ k1 ≤ g (Suc i) ⟶ g i ≤ k2 ∧ k2 ≤ g (Suc i) ⟶ yi k1 = yi k2 ⟶ k1 = k2"
proof (intro allI impI)
fix k1 k2
assume d1: "g i ≤ k1 ∧ k1 ≤ g (Suc i)"
and d2: "g i ≤ k2 ∧ k2 ≤ g (Suc i)" and d3: "yi k1 = yi k2"
have "g i ≤ k1 ∧ k1 ≤ g i + f i" using d1 b3 by simp
then have "∃ t. k1 = g i + t ∧ t ≤ f i" by presburger
then obtain t1 where d4: "k1 = g i + t1 ∧ t1 ≤ f i" by blast
have "g i ≤ k2 ∧ k2 ≤ g i + f i" using d2 b3 by simp
then have "∃ t. k2 = g i + t ∧ t ≤ f i" by presburger
then obtain t2 where d5: "k2 = g i + t2 ∧ t2 ≤ f i" by blast
have "t1 < f i ∧ t2 < f i ⟶ k1 = k2"
proof
assume "t1 < f i ∧ t2 < f i"
then have "yi k1 = yin i t1 ∧ yi k2 = yin i t2" using d4 d5 b5 by blast
then have "yin i t1 = yin i t2" using d3 by metis
then show "k1 = k2" using c1 d4 d5 unfolding inj_on_def by blast
qed
moreover have "t1 = f i ∧ t2 < f i ⟶ False"
proof
assume e1: "t1 = f i ∧ t2 < f i"
then have e2: "yi k2 = yin i t2" using d4 d5 b5 by blast
have e3: "k1 = g (Suc i)" using e1 d4 b3 by simp
then have "yi k1 = yin (Suc i) 0" using b1 b5[of k1 "Suc i" 0] by simp
moreover have "yi k1 = yin i (f i)" using e3 b9 b2 by simp
ultimately have "yin i t2 = yin i (f i)" using e2 d3 by metis
then have "t2 = f i" using c1 d5 unfolding inj_on_def by blast
then show "False" using e1 by force
qed
moreover have "t1 < f i ∧ t2 = f i ⟶ False"
proof
assume e1: "t1 < f i ∧ t2 = f i"
then have e2: "yi k1 = yin i t1" using d4 d5 b5 by blast
have e3: "k2 = g (Suc i)" using e1 d5 b3 by simp
then have "yi k2 = yin (Suc i) 0" using b1 b5[of k2 "Suc i" 0] by simp
moreover have "yi k2 = yin i (f i)" using e3 b9 b2 by simp
ultimately have "yin i t1 = yin i (f i)" using e2 d3 by metis
then have "t1 = f i" using c1 d4 unfolding inj_on_def by blast
then show "False" using e1 by force
qed
ultimately show "k1 = k2" using d4 d5 by force
qed
then show "inj_on yi { k. g i ≤ k ∧ k ≤ g (Suc i) }" unfolding inj_on_def by blast
qed
moreover have "∀ m. ∃ n. g n ≤ m ∧ Suc m ≤ g (Suc n)"
proof
fix m
obtain n k where "m = g n + k ∧ k < f n" using b1 b3 lem_sum_ind_ex[of g f m] by blast
then have "g n ≤ m ∧ Suc m ≤ g (Suc n)" using b3 by simp
then show "∃ n. g n ≤ m ∧ Suc m ≤ g (Suc n)" by blast
qed
moreover have "∀ k i i'. g i ≤ k ∧ Suc k ≤ g (Suc i) ∧ g i' ≤ k ∧ Suc k ≤ g (Suc i') ⟶ i = i'"
proof (intro allI impI)
fix k i i'
assume "g i ≤ k ∧ Suc k ≤ g (Suc i) ∧ g i' ≤ k ∧ Suc k ≤ g (Suc i')"
moreover then have "k < g i + f i ∧ k < g i' + f i'" using b3 by simp
ultimately have "∃ l1. k = g i + l1 ∧ l1 < f i" and "∃ l2. k = g i' + l2 ∧ l2 < f i'" by presburger+
then obtain l1 l2 where "k = g i + l1 ∧ l1 < f i" and "k = g i' + l2 ∧ l2 < f i'" by blast
then show "i = i'" using b1 b3 lem_sum_ind_un[of g f k i l1 i' l2] by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_sv_un3:
fixes r1 r2 r3::"'U rel"
assumes "single_valued (r1 ∪ r3)" and "single_valued (r2 ∪ r3)" and "Field r1 ∩ Field r2 = {}"
shows "single_valued (r1 ∪ r2 ∪ r3)"
using assms unfolding single_valued_def Field_def by blast
lemma lem_cfcomp_d2uset:
fixes κ::"'U rel" and r::"'U rel" and W::"'U rel ⇒ 'U set" and R::"'U rel ⇒ 'U rel"
and S::"'U rel set"
assumes a1: "κ =o cardSuc |UNIV::nat set|"
and a3: "T = { t::'U rel. t ≠ {} ∧ CCR t ∧ single_valued t ∧ acyclic t ∧ (∀x∈Field t. t``{x} ≠ {}) }"
and a4: "Refl r"
and a5: "S ⊆ {α ∈ 𝒪::'U rel set. α <o κ}"
and a6: "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S|"
and a7: "∀ α ∈ S. ∃ β ∈ S. α <o β"
and a8: "Field r = (⋃α∈S. W α)" and a9: "∀α∈S. ∀ β∈S. α ≠ β ⟶ W α ∩ W β = {}"
and a10: "⋀ α. α ∈ S ⟹ R α ∈ T ∧ R α ⊆ r ∧ |W α| ≤o |UNIV::nat set|
∧ Field (R α) = W α ∧ ¬ Conelike (Restr r (W α))"
and a11: "⋀ α x. α ∈ S ⟹ x ∈ W α ⟹ ∃ a.
((x,a) ∈ (Restr r (W α))^* ∧ (∀ β ∈ S. α <o β ⟶ (r``{a} ∩ W β) ≠ {}))"
shows "∃ r'. CCR r' ∧ DCR 2 r' ∧ r' ⊆ r ∧ (∀ a ∈ Field r. ∃ b ∈ Field r'. (a,b) ∈ r^*)"
proof -
obtain l :: "'U ⇒ 'U rel" where q1: "l = (λ a. SOME α. α ∈ S ∧ a ∈ W α)" by blast
have q2: "⋀ a. a ∈ Field r ⟹ l a ∈ S ∧ a ∈ W (l a)"
proof -
fix a
assume "a ∈ Field r"
then obtain α where "α ∈ S ∧ a ∈ W α" using q1 a8 by blast
then show "l a ∈ S ∧ a ∈ W (l a)" using q1 someI_ex[of "λ α. α ∈ S ∧ a ∈ W α"] by metis
qed
have q3: "⋀ α a. α ∈ S ⟹ a ∈ W α ⟹ l a = α"
proof -
fix α a
assume "α ∈ S" and "a ∈ W α"
moreover then have "a ∈ W (l a) ∧ α ∈ S ∧ l a ∈ S" using q2 a8 a10 by fast
ultimately show "l a = α" using a9 by blast
qed
have b1: "⋀ α. α ∈ S ⟹ (R α) ∈ T" using a3 a10 by blast
have b4: "⋀ α. α ∈ S ⟹ (R α) ⊆ r" using a10 by blast
have b7: "∀ α ∈ S. ∀ β ∈ S. ∃ γ∈S. (α <o γ ∨ α = γ) ∧ (β <o γ ∨ β = γ)"
proof (intro ballI)
fix α β
assume "α ∈ S" and "β ∈ S"
then have "Well_order α ∧ Well_order β" and "α ∈ S ∧ β ∈ S"
using a5 unfolding ordLess_def by blast+
moreover then have "α <o β ∨ β <o α ∨ α =o β"
using ordLeq_iff_ordLess_or_ordIso ordLess_or_ordLeq by blast
ultimately show "∃ γ ∈ S. (α <o γ ∨ α = γ) ∧ (β <o γ ∨ β = γ)"
using a3 a5 lem_Oeq[of α β] by blast
qed
obtain s :: "'U rel ⇒ nat ⇒ 'U" where b8: "s = (λ α. SOME xi. cfseq (R α) xi)" by blast
moreover have "∀ α ∈ S. ∃ xi. cfseq (R α) xi" using b1 a3 lem_ccrsv_cfseq by blast
ultimately have b9: "⋀ α. α ∈ S ⟹ cfseq (R α) (s α)" by (metis someI_ex)
obtain en where b_en: "en = (λ α. SOME g :: nat ⇒ 'U. W α ⊆ g`UNIV)" by blast
obtain ta :: "'U ⇒ 'U rel ⇒ 'U"
where b10: "ta = (λ u α'. SOME u'. (u,u') ∈ r ∧ u' ∈ W α')" by blast
obtain t :: "('U rel) × 'U ⇒ 'U rel ⇒ 'U"
where b11: "t = (λ (α,a) α'. ta a α')" by blast
obtain tm :: "('U rel) × nat ⇒ 'U rel ⇒ 'U"
where b12: "tm = (λ (α,k) α'. t (α,(en α k)) α')" by blast
obtain jnN :: "'U ⇒ 'U ⇒ 'U"
where b13: "jnN = (λ u u'. SOME v. (u,v) ∈ (R (l u))^* ∧ (u',v) ∈ (R (l u))^*)" by blast
obtain h where b20: "⋀ α k1 β k2. α ∈ S ∧ β ∈ S ⟹
(∃ γ ∈ S. α <o γ ∧ β <o γ ∧ h γ = jnN (tm (α,k1) γ) (tm (β,k2) γ) )"
using a1 a5 a6 a7 lem_jnfix_cardsuc[of "UNIV::nat set" κ S jnN tm] by blast
define EP where "EP = (λ α. { a ∈ W α. ∀ β ∈ S. α <o β ⟶ (r``{a} ∩ W β) ≠ {} })"
have b24: "⋀ α k b. α ∈ S ⟹ (s α k, b) ∈ (R α)^* ⟹ (∃ k'≥k. b = s α k')"
proof -
fix α k b
assume c1: "α ∈ S" and c2: "(s α k, b) ∈ (R α)^*"
moreover then have "single_valued (R α)" using b1 a3 by blast
moreover have " ∀i. (s α i, s α (Suc i)) ∈ R α" using c1 b9 unfolding cfseq_def by blast
ultimately show "∃ k'≥k. b = s α k'"
using lem_rseq_svacyc_inv_rtr[of "R α" "s α" k b] by blast
qed
have b25: "⋀ α k b. α ∈ S ⟹ (s α k, b) ∈ (R α)^+ ⟹ (∃ k'>k. b = s α k')"
proof -
fix α k b
assume c1: "α ∈ S" and c2: "(s α k, b) ∈ (R α)^+"
moreover then have "single_valued (R α)" using b1 a3 by blast
moreover have " ∀i. (s α i, s α (Suc i)) ∈ R α" using c1 b9 unfolding cfseq_def by blast
ultimately show "∃ k'>k. b = s α k'" using lem_rseq_svacyc_inv_tr[of "R α" "s α" k b] by blast
qed
have b26: "⋀ α a b c. α ∈ S ⟹ a ∈ W α ⟹ b ∈ W α ⟹
c = jnN a b ⟹ c ∈ W α ∧ (a, c) ∈ (R α)^* ∧ (b, c) ∈ (R α)^*"
proof -
fix α a b c
assume c1: "α ∈ S" and c2: "a ∈ W α" and c3: "b ∈ W α" and c4: "c = jnN a b"
then have "CCR (R α) ∧ a ∈ Field (R α) ∧ b ∈ Field (R α)" using c1 b1 a3 a10 by blast
then have "∃ c'. (a, c') ∈ (R α)^* ∧ (b, c') ∈ (R α)^*" unfolding CCR_def by blast
moreover have "l a = α" using c1 c2 q3 by blast
moreover then have "c = (SOME c'. (a, c') ∈ (R α)^* ∧ (b, c') ∈ (R α)^*)" using c4 b13 by simp
ultimately have c5: "(a, c) ∈ (R α)^* ∧ (b, c) ∈ (R α)^*"
using someI_ex[of "λ c'. (a, c') ∈ (R α)^* ∧ (b, c') ∈ (R α)^*"] by force
moreover have "W α ∈ Inv (R α)" using c1 a10[of α] unfolding Field_def Inv_def by blast
moreover then have "c ∈ W α" using c2 c5 lem_Inv_restr_rtr2[of "W α" "R α"] by blast
ultimately show "c ∈ W α ∧ (a, c) ∈ (R α)^* ∧ (b, c) ∈ (R α)^*" by blast
qed
have b_enr: "⋀ α. α ∈ S ⟹ W α ⊆ (en α)`(UNIV::nat set)"
proof -
fix α
assume "α ∈ S"
then have "|W α| ≤o |UNIV::nat set|" using a10 by blast
then obtain g::"nat ⇒ 'U" where "W α ⊆ g`UNIV"
by (metis card_of_ordLeq2 empty_subsetI order_refl)
then show "W α ⊆ (en α)`UNIV" unfolding b_en using someI_ex by metis
qed
have b_h: "⋀ α a β b. α ∈ S ∧ β ∈ S ⟹ a ∈ EP α ∧ b ∈ EP β ⟹
(∃ γ ∈ S. ∃ a' ∈ W γ. ∃ b' ∈ W γ. α <o γ ∧ β <o γ
∧ (a,a') ∈ r ∧ (a', h γ) ∈ (R γ)^* ∧ (b,b') ∈ r ∧ (b', h γ) ∈ (R γ)^*)"
proof -
fix α a β b
assume c1: "α ∈ S ∧ β ∈ S" and c2: "a ∈ EP α ∧ b ∈ EP β"
then have "a ∈ W α ∧ b ∈ W β" unfolding EP_def by blast
moreover then obtain k1 k2 where c3: "a = en α k1 ∧ b = en β k2" using c1 b_enr by blast
ultimately obtain γ where c4: "γ ∈ S ∧ α <o γ ∧ β <o γ"
and c5: "h γ = jnN (tm (α,k1) γ) (tm (β,k2) γ)" using c1 b20 by blast
have "ta a γ = (SOME a'. (a, a') ∈ r ∧ a' ∈ W γ)" using b10 by simp
moreover have "∃ x. (a, x) ∈ r ∧ x ∈ W γ" using c2 c4 unfolding EP_def by blast
ultimately have c6: "(a, ta a γ) ∈ r ∧ ta a γ ∈ W γ"
using someI_ex[of "λ a'. (a, a') ∈ r ∧ a' ∈ W γ"] by metis
have "ta b γ = (SOME a'. (b, a') ∈ r ∧ a' ∈ W γ)" using b10 by simp
moreover have "∃ x. (b, x) ∈ r ∧ x ∈ W γ" using c2 c4 unfolding EP_def by blast
ultimately have c7: "(b, ta b γ) ∈ r ∧ ta b γ ∈ W γ"
using someI_ex[of "λ a'. (b, a') ∈ r ∧ a' ∈ W γ"] by metis
have "h γ = jnN (ta a γ) (ta b γ)" using c3 c5 b11 b12 by simp
moreover have "ta a γ ∈ W γ ∧ ta b γ ∈ W γ" using c6 c7 by blast
ultimately have "h γ ∈ W γ ∧ (ta a γ, h γ) ∈ (R γ)^* ∧ (ta b γ, h γ) ∈ (R γ)^*"
using c4 b26[of γ "ta a γ" "ta b γ" "h γ"] by blast
then show "∃ γ ∈ S. ∃ a' ∈ W γ. ∃ b' ∈ W γ. α <o γ ∧ β <o γ
∧ (a,a') ∈ r ∧ (a', h γ) ∈ (R γ)^* ∧ (b,b') ∈ r ∧ (b', h γ) ∈ (R γ)^*"
using c4 c6 c7 by blast
qed
have p1: "⋀ α. α ∈ S ⟹ R α ⊆ Restr r (W α)" using a10 unfolding Field_def by fastforce
have p2: "⋀ α. α ∈ S ⟹ Field (Restr r (W α)) = W α"
proof -
fix α
assume "α ∈ S"
then have "W α ⊆ Field r" using a10 unfolding Field_def by blast
moreover have "SF r = {A. A ⊆ Field r}" using a4 unfolding SF_def refl_on_def Field_def by fast
ultimately have "W α ∈ SF r" by blast
then show "Field (Restr r (W α)) = W α" unfolding SF_def by blast
qed
have p3: "⋀ α. α ∈ S ⟹ ∀n. ∃k≥n. (s α (Suc k), s α k) ∉ (Restr r (W α))^*"
proof -
fix α
assume c1: "α ∈ S"
have "∀a∈Field (Restr r (W α)). ∃i. (a, s α i) ∈ (Restr r (W α))^*"
proof
fix a
assume "a ∈ Field (Restr r (W α))"
then have "a ∈ Field (R α)" using c1 a10[of α] unfolding Field_def by blast
then obtain i where "(a, s α i) ∈ (R α)^*" using c1 b9[of α] unfolding cfseq_def by blast
moreover have "R α ⊆ Restr r (W α)" using c1 p1 by blast
ultimately show "∃i. (a, s α i) ∈ (Restr r (W α))^*" using rtrancl_mono by blast
qed
moreover have "∀i. (s α i, s α (Suc i)) ∈ Restr r (W α)"
using c1 p1 b9[of α] unfolding cfseq_def using rtrancl_mono by blast
ultimately have "cfseq (Restr r (W α)) (s α)" unfolding cfseq_def by blast
then show "∀n. ∃k≥n. (s α (Suc k), s α k) ∉ (Restr r (W α))^*"
using c1 a10[of α] lem_cfseq_ncl[of "Restr r (W α)" "s α"] by blast
qed
obtain E where b27: "E = (λ α. { k. (s α (Suc k), s α k) ∉ (Restr r (W α))^* })" by blast
obtain P where b28: "P = (λ α. (s α)`(E α) )" by blast
obtain K where b29: "K = (λ α. { a ∈ W α. (h α ∈ W α ⟶ (h α, a) ∈ (R α)^*)
∧ (a, h α) ∉ (R α)^* })" by blast
let ?F = "λ α. P α ∩ K α"
have b31: "⋀ α. α ∈ S ⟹ P α ∈ SCF (R α)"
proof -
fix α
assume c1: "α ∈ S"
then have "P α ⊆ Field (R α)" using b9 b28 lem_cfseq_fld by blast
moreover have "∀ a ∈ Field (R α). ∃ b ∈ P α. (a, b) ∈ (R α)^*"
proof
fix a
assume "a ∈ Field (R α)"
then obtain i where d1: "(a, s α i) ∈ (R α)^*" using c1 b9[of α] unfolding cfseq_def by blast
then obtain k where "i≤k ∧ (s α (Suc k), s α k) ∉ (Restr r (W α))^*" using c1 p3[of α] by blast
moreover then have d2: "(s α i, s α k) ∈ (R α)^*"
using c1 b9[of α] lem_rseq_rtr unfolding cfseq_def by blast
ultimately have "s α k ∈ P α" using b27 b28 by blast
moreover have "(a, s α k) ∈ (R α)^*" using d1 d2 by simp
ultimately show "∃ b ∈ P α. (a, b) ∈ (R α)^*" by blast
qed
ultimately show "P α ∈ SCF (R α)" unfolding SCF_def by blast
qed
have b32: "⋀ α. α ∈ S ⟹ K α ∈ SCF (R α) ∩ Inv (R α)"
proof
fix α
assume c1: "α ∈ S"
have "∀a∈Field (R α). ∃b∈K α. (a, b) ∈ (R α)^*"
proof
fix a
assume d1: "a ∈ Field (R α)"
show "∃b∈K α. (a, b) ∈ (R α)^*"
proof (cases "h α ∈ Field (R α)")
assume "h α ∈ Field (R α)"
moreover have "CCR (R α)" using c1 b1 a3 by blast
ultimately obtain a' where "a' ∈ Field (R α)"
and e1: "(a,a') ∈ (R α)^* ∧ (h α, a') ∈ (R α)^*"
using d1 unfolding CCR_def by blast
then obtain b where e2: "(a', b) ∈ (R α)" using c1 b1 a3 by blast
then have "b ∈ Field (R α)" unfolding Field_def by blast
moreover have "(h α, b) ∈ (R α)^*" using e1 e2 by force
moreover have "(b, h α) ∈ (R α)^* ⟶ False"
proof
assume "(b, h α) ∈ (R α)^*"
then have "(b, b) ∈ (R α)^+" using e1 e2 by fastforce
then show "False" using c1 b1 a3 unfolding acyclic_def by blast
qed
moreover have "(a, b) ∈ (R α)^*" using e1 e2 by force
ultimately show ?thesis using b29 c1 a10 by blast
next
assume "h α ∉ Field (R α)"
then have "(a, h α) ∉ (R α)^* ∧ h α ∉ W α" using d1 c1 a10 lem_rtr_field[of a] by blast
then have "a ∈ K α" using d1 b29 c1 a10 by blast
then show ?thesis by blast
qed
qed
then show "K α ∈ SCF (R α)" using b29 c1 a10 unfolding SCF_def by blast
next
fix α
assume c1: "α ∈ S"
have "∀ a b. a ∈ K α ∧ (a,b) ∈ (R α) ⟶ b ∈ K α"
proof (intro allI impI)
fix a b
assume d1: "a ∈ K α ∧ (a,b) ∈ (R α)"
then have d3: "a ∈ Field (R α)" and d4: "(a, h α) ∉ (R α)⇧*" using b29 c1 a10 by blast+
have "b ∈ Field (R α)" using d1 unfolding Field_def by blast
moreover have "h α ∈ W α ⟶ (h α, b) ∈ (R α)^*" using d1 b29 by force
moreover have "(b, h α) ∈ (R α)^* ⟶ False"
proof
assume "(b, h α) ∈ (R α)^*"
then have "(a, h α) ∈ (R α)^*" using d1 by force
then show "False" using d4 by blast
qed
ultimately show "b ∈ K α" using b29 c1 a10 by blast
qed
then show "K α ∈ Inv (R α)" using b29 unfolding Inv_def by blast
qed
have b33: "⋀ α. α ∈ S ⟹ ?F α ∈ SCF (R α)"
proof -
fix α
assume c1: "α ∈ S"
have "K α ∈ SCF (R α) ∩ Inv (R α)" using c1 b31 b32 unfolding Inv_def by blast+
moreover have "P α ∈ SCF (R α)" using c1 b31 b32 lem_scfinv_scf_int by blast
ultimately have "K α ∩ P α ∈ SCF (R α)" using lem_scfinv_scf_int by blast
moreover have "?F α = K α ∩ P α" by blast
ultimately show "?F α ∈ SCF (R α)" by metis
qed
define rei where "rei = (λ α. SOME k. k ∈ E α ∧ (s α k) ∈ ?F α)"
define re0 where "re0 = (λ α. s α (rei α))"
define re1 where "re1 = (λ α. s α (Suc (rei α)))"
define ep where "ep = (λ α. SOME b. (re1 α, b) ∈ (Restr r (W α))^* ∧ b ∈ EP α)"
define spl where "spl = (λ α. spthlen (Restr r (W α)) (re1 α) (ep α))"
define sp where "sp = (λ α. SOME f. f ∈ spth (Restr r (W α)) (re1 α) (ep α))"
define R0 where "R0 = (λ α. { (a,b) ∈ R α. (b, re0 α) ∈ (R α)^* })"
define R2 where "R2 = (λ α. { (a,b). ∃ k < (spl α). a = sp α k ∧ b = sp α (Suc k) })"
define R' where "R' = (λ α. R0 α ∪ R2 α ∪ { (re0 α, re1 α) })"
define re' where "re' = ({ (a,b) ∈ r. ∃ α ∈ S. ∃ β ∈ S. α <o β ∧ a = ep α ∧ b ∈ W β ∧ (b, h β) ∈ (R β)^* })"
define r' where "r' = (re' ∪ (⋃α∈S. R' α))"
have b_Fne: "⋀ α. α ∈ S ⟹ ?F α ≠ {}"
proof -
fix α
assume "α ∈ S"
then have "?F α ∈ SCF (R α) ∧ R α ≠ {}" using b33 a3 a10 by blast
then show "?F α ≠ {}" unfolding SCF_def Field_def by force
qed
have b_re0: "⋀ α. α ∈ S ⟹ re0 α ∈ ?F α ∧ rei α ∈ E α"
proof -
fix α
assume "α ∈ S"
then obtain k where "k ∈ E α ∧ (s α k) ∈ ?F α" using b_Fne b28 by force
then have "(s α (rei α)) ∈ ?F α " and "rei α ∈ E α"
using someI_ex[of "λ k. k ∈ E α ∧ s α k ∈ P α ∩ K α"] unfolding rei_def by metis+
then show "re0 α ∈ ?F α ∧ rei α ∈ E α" unfolding re0_def by blast
qed
have b_rs: "⋀ α. α ∈ S ⟹ s α ` UNIV ⊆ W α"
proof -
fix α
assume "α ∈ S"
then have "cfseq (R α) (s α) ∧ Field (R α) = W α" using b9 a3 a10 by blast
then show "s α ` UNIV ⊆ W α" using lem_rseq_rtr unfolding cfseq_def by blast
qed
have b_injs: "⋀ α k1 k2. α ∈ S ⟹ s α k1 = s α k2 ⟹ k1 = k2"
proof -
fix α k1 k2
assume "α ∈ S" and "s α k1 = s α k2"
moreover then have "cfseq (R α) (s α) ∧ acyclic (R α)" using b9 a3 a10 by blast
moreover then have "inj (s α)" using lem_cfseq_inj by blast
ultimately show "k1 = k2" unfolding inj_on_def by blast
qed
have b_re1: "⋀ α. α ∈ S ⟹ re1 α = s α (Suc (rei α))"
proof -
fix α
assume c1: "α ∈ S"
then have "re0 α ∈ ?F α" using b_re0[of α] by blast
then obtain k where c2: "re0 α = s α k ∧ k ∈ E α" unfolding b28 by blast
then have "(s α (Suc k), s α k) ∉ (Restr r (W α))^*" unfolding b27 by blast
have "rei α = k" using c1 c2 b_injs unfolding re0_def by blast
moreover have "re1 α = s α (Suc (rei α))" unfolding re1_def by blast
ultimately show "re1 α = s α (Suc (rei α))" by blast
qed
have b_re12: "⋀ α. α ∈ S ⟹ (re0 α, re1 α) ∈ R α ∧ (re1 α, re0 α) ∉ (Restr r (W α))^*"
proof -
fix α
assume c1: "α ∈ S"
then have "re0 α = s α (rei α)" and "re1 α = s α (Suc (rei α))"
and "cfseq (R α) (s α)" using b9 b_re1 re0_def by blast+
then have "(re0 α, re1 α) ∈ R α" unfolding cfseq_def by simp
moreover have "(re1 α, re0 α) ∈ (Restr r (W α))^* ⟶ False"
proof
assume "(re1 α, re0 α) ∈ (Restr r (W α))^*"
then have "(s α (Suc (rei α)), s α (rei α)) ∈ (Restr r (W α))^*"
using c1 b_re1[of α] unfolding re0_def by metis
moreover have "(s α (Suc (rei α)), s α (rei α)) ∉ (Restr r (W α))^*"
using c1 b_re0[of α] b27 by blast
ultimately show "False" by blast
qed
ultimately show "(re0 α, re1 α) ∈ R α ∧ (re1 α, re0 α) ∉ (Restr r (W α))^*" by blast
qed
have b_rw: "⋀ α a b. α ∈ S ⟹ a ∈ W α ⟹ (a,b) ∈ (Restr r (W α))^* ⟹ b ∈ W α"
proof -
fix α a b
assume "α ∈ S" and "a ∈ W α" and "(a,b) ∈ (Restr r (W α))^*"
then show "b ∈ W α" using lem_Inv_restr_rtr2[of _ "Restr r (W α)"] unfolding Inv_def by blast
qed
have b_r0w: "⋀ α a b. α ∈ S ⟹ a ∈ W α ⟹ (a,b) ∈ (R α)^* ⟹ b ∈ W α"
using p1 b_rw rtrancl_mono by blast
have b_ep: "⋀ α. α ∈ S ⟹ (re1 α, ep α) ∈ (Restr r (W α))^* ∧ ep α ∈ EP α"
proof -
fix α
assume c1: "α ∈ S"
moreover then have c2: "re1 α ∈ W α" using b_rs[of α] b_re1[of α] by blast
ultimately obtain b
where c3: "(re1 α, b) ∈ (Restr r (W α))^* ∧ (∀β∈S. α <o β ⟶ r``{b} ∩ W β ≠ {})"
using a11[of α "re1 α"] by blast
then have "b ∈ W α" using c1 c2 b_rw[of α] by blast
moreover obtain L where c4: "L = (λ b. (re1 α, b) ∈ (Restr r (W α))^* ∧ b ∈ EP α)" by blast
ultimately have "L b" and "ep α = (SOME b. L b)" using c3 unfolding EP_def ep_def by blast+
then have "L (ep α)" using someI_ex by metis
then show "(re1 α, ep α) ∈ (Restr r (W α))^* ∧ ep α ∈ EP α" using c4 by blast
qed
have b_sp: "⋀ α. α ∈ S ⟹ sp α ∈ spth (Restr r (W α)) (re1 α) (ep α)"
proof -
fix α
assume "α ∈ S"
then have "(re1 α, ep α) ∈ (Restr r (W α))^*" using b_ep by blast
then obtain f where "f ∈ spth (Restr r (W α)) (re1 α) (ep α)"
using lem_spthlen_rtr lem_rtn_rpth_inj unfolding spth_def by metis
then show "sp α ∈ spth (Restr r (W α)) (re1 α) (ep α)"
unfolding sp_def using someI_ex by metis
qed
have b_R0: "⋀ α a. α ∈ S ⟹ (a,re0 α) ∈ (R α)^* ⟹ (a,re0 α) ∈ (R0 α)^*"
proof -
fix α a
assume "α ∈ S" and "(a,re0 α) ∈ (R α)^*"
then obtain g n where "g ∈ rpth (R α) a (re0 α) n" using lem_ccext_rtr_rpth[of a "re0 α"] by blast
then have c1: "g 0 = a ∧ g n = re0 α" and c2: "∀i<n. (g i, g (Suc i)) ∈ R α" unfolding rpth_def by blast+
then have "∀ i≤n. (g i, re0 α) ∈ (R α)^*" using lem_rseq_tl by metis
then have "∀ i<n. (g i, g (Suc i)) ∈ R0 α" using c2 unfolding R0_def by simp
then show "(a, re0 α) ∈ (R0 α)^*"
using c1 lem_ccext_rpth_rtr[of "R0 α" a "re0 α" n] unfolding rpth_def by blast
qed
have b_hr0: "⋀ α. α ∈ S ⟹ h α ∈ W α ⟹ (h α, re0 α) ∈ (R0 α)^*"
using b_re0 b_R0 b29 by blast
have b_hf: "⋀ α. α ∈ S ⟹ h α ∈ W α ⟹ h α ∈ Field r'"
proof -
fix α
assume c1: "α ∈ S" and "h α ∈ W α"
then have "(h α, re0 α) ∈ (R0 α)^*" using c1 b_hr0 by blast
moreover have "R0 α ⊆ R' α" using c1 unfolding R'_def by blast
ultimately have "(h α, re0 α) ∈ (R' α)^*" using rtrancl_mono by blast
moreover have "re0 α ∈ Field (R' α)" unfolding R'_def Field_def by blast
ultimately have "h α ∈ Field (R' α)" using lem_rtr_field[of "h α" "re0 α"] by force
moreover have "R' α ⊆ r'" using c1 unfolding r'_def by blast
ultimately show "h α ∈ Field r'" unfolding Field_def by blast
qed
have b_fR': "⋀ α. α ∈ S ⟹ Field (R' α) ⊆ W α"
proof -
fix α
assume c1: "α ∈ S"
then have "Field (R0 α) ⊆ W α" using a10 unfolding R0_def Field_def by blast
moreover have "Field (R2 α) ⊆ W α"
proof
fix a
assume "a ∈ Field (R2 α)"
then obtain x y where d1: "(x,y) ∈ R2 α ∧ (a = x ∨ a = y)" unfolding Field_def by blast
then obtain k where "k < spl α ∧ (x,y) = (sp α k, sp α (Suc k))" unfolding R2_def by blast
then show "a ∈ W α" using d1 c1 b_sp[of α] unfolding spth_def rpth_def spl_def by blast
qed
moreover have "re0 α ∈ W α" using c1 b_re0[of α] b29 by blast
moreover have "re1 α ∈ W α" using c1 b_re12[of α] a10[of α] unfolding Field_def by blast
ultimately show "Field (R' α) ⊆ W α" unfolding R'_def Field_def by fast
qed
have b_fR2: "⋀ α a. α ∈ S ⟹ a ∈ Field (R2 α) ⟹ ∃ k. k ≤ spl α ∧ a = sp α k"
proof -
fix α a
assume "α ∈ S" and "a ∈ Field (R2 α)"
then obtain x y where "(x,y) ∈ R2 α ∧ (a = x ∨ a = y)" unfolding Field_def by blast
moreover then obtain k' where "k' < spl α ∧ x = sp α k' ∧ y = sp α (Suc k')"
unfolding R2_def by blast
ultimately show "∃ k. k ≤ spl α ∧ a = sp α k" by (metis Suc_leI less_or_eq_imp_le)
qed
have b_bhf: "⋀ α a. α ∈ S ⟹ a ∈ W α ⟹ (a, h α) ∈ (R α)^* ⟹ a ∈ Field (R' α)"
proof -
fix α a
assume c1: "α ∈ S" and c2: "a ∈ W α" and c3: "(a, h α) ∈ (R α)^*"
then have "(h α, re0 α) ∈ (R0 α)^*" using b_hr0[of α] b_r0w[of α] by blast
moreover have "R0 α ⊆ R α" unfolding R0_def by blast
ultimately have "(h α, re0 α) ∈ (R α)^*" using c3 rtrancl_mono by blast
then have "(a, re0 α) ∈ (R α)^*" using c3 by force
then have "(a, re0 α) ∈ (R0 α)^*" using c1 c3 b_R0[of α] by blast
moreover have "R0 α ⊆ R' α" unfolding R'_def by blast
ultimately have "(a, re0 α) ∈ (R' α)^*" using rtrancl_mono by blast
moreover have "re0 α ∈ Field (R' α)" unfolding R'_def Field_def by blast
ultimately show "a ∈ Field (R' α)" using lem_rtr_field[of a "re0 α"] by blast
qed
have b_clR': "⋀ α a. α ∈ S ⟹ a ∈ Field (R' α) ⟹ (a, ep α) ∈ (R' α)^*"
proof -
fix α a
assume c1: "α ∈ S" and c2: "a ∈ Field (R' α)"
have c3: "sp α 0 = re1 α" using c1 b_sp[of α] unfolding spth_def spl_def rpth_def by blast
then have "a ∈ Field (R2 α) ∨ a = re1 α ⟶ (∃ k. k ≤ spl α ∧ a = sp α k)" using c1 b_fR2 by force
moreover have "a ∈ Field (R0 α) ∨ a = re0 α ⟶ (a, re0 α) ∈ (R α)^*"
unfolding R0_def Field_def by fastforce
moreover have "a ∈ Field (R0 α) ∨ a ∈ Field (R2 α) ∨ a = re0 α ∨ a = re1 α"
using c1 c2 unfolding R'_def Field_def by blast
moreover have c4: "∀ k. (k ≤ spl α ⟶ (sp α k, ep α) ∈ (R' α)^*)"
proof (intro allI impI)
fix k
assume "k ≤ spl α"
moreover have "sp α (spl α) = ep α"
using c1 b_sp[of α] unfolding spth_def spl_def rpth_def by blast
moreover have "∀ i < spl α. (sp α i, sp α (Suc i)) ∈ R' α"
unfolding R'_def R2_def by blast
ultimately show "(sp α k, ep α) ∈ (R' α)^*" using lem_rseq_tl by metis
qed
moreover have "(a, re0 α) ∈ (R α)^* ⟶ (a, ep α) ∈ (R' α)^*"
proof
assume "(a, re0 α) ∈ (R α)^*"
then have "(a, re0 α) ∈ (R0 α)^*" using c1 b_R0 by blast
moreover have "R0 α ⊆ R' α" using c1 unfolding R'_def by blast
ultimately have "(a, re0 α) ∈ (R' α)^*" using rtrancl_mono by blast
moreover have "(re0 α, re1 α) ∈ (R' α)" using c1 unfolding R'_def by blast
moreover have "(re1 α, ep α) ∈ (R' α)^*" using c3 c4 by force
ultimately show "(a, ep α) ∈ (R' α)^*" by simp
qed
ultimately show "(a, ep α) ∈ (R' α)^*" by blast
qed
have b_epr': "⋀ a. a ∈ Field r' ⟹ ∃ α ∈ S. (a, ep α) ∈ (R' α)^*"
proof -
fix a
assume "a ∈ Field r'"
then have "a ∈ Field re' ∨ (∃ α∈S. a ∈ Field (R' α))" unfolding r'_def Field_def by blast
moreover have "a ∈ Field re' ⟶ (∃ α ∈ S. (a, ep α) ∈ (R' α)^*)"
proof
assume "a ∈ Field re'"
then obtain x y α β where d1: "a = x ∨ a = y" and d2: "α ∈ S ∧ β ∈ S ∧ α <o β"
and d3: "x = ep α ∧ y ∈ W β ∧ (y, h β) ∈ (R β)^*"
unfolding re'_def Field_def by blast
have "(x, ep α) ∈ (R' α)^*" using d3 by blast
moreover have "(y, ep β) ∈ (R' β)^*" using d2 d3 b_bhf[of β y] b_clR'[of β] by blast
ultimately show "∃ α ∈ S. (a, ep α) ∈ (R' α)^*" using d1 d2 by blast
qed
ultimately show "∃ α ∈ S. (a, ep α) ∈ (R' α)^*" using b_clR' by blast
qed
have b_svR': "⋀ α. α ∈ S ⟹ single_valued (R' α)"
proof -
fix α
assume c1: "α ∈ S"
have c2: "re0 α ∈ Domain (R0 α) ⟶ False"
proof
assume "re0 α ∈ Domain (R0 α)"
then obtain b where "(re0 α, b) ∈ R0 α" by blast
then have "(re0 α, b) ∈ R α ∧ (b, re0 α) ∈ (R α)^*" unfolding R0_def by blast
then have "(re0 α, re0 α) ∈ (R α)^+" by force
moreover have "acyclic (R α)" using c1 a10 a3 by blast
ultimately show "False" unfolding acyclic_def by blast
qed
have c3: "re0 α ∈ Domain (R2 α) ⟶ False"
proof
assume "re0 α ∈ Domain (R2 α)"
then obtain b where "(re0 α, b) ∈ R2 α" by blast
then obtain k where d1: "k ≤ spl α ∧ re0 α = sp α k ∧ b = sp α (Suc k)"
unfolding R2_def by force
have "sp α ∈ spth (Restr r (W α)) (re1 α) (ep α)" using c1 b_sp by blast
then have "sp α 0 = re1 α" and "∀i<spl α. (sp α i, sp α (Suc i)) ∈ Restr r (W α)"
unfolding spth_def spl_def rpth_def by blast+
then have "(re1 α, re0 α) ∈ (Restr r (W α))^*" using d1 lem_rseq_hd by metis
then show "False" using c1 b_re12[of α] by blast
qed
have c4: "∀ a ∈ Field (R0 α) ∩ Field (R2 α). False"
proof
fix a
assume d1: "a ∈ Field (R0 α) ∩ Field (R2 α)"
obtain k where d2: "k ≤ spl α ∧ a = sp α k" using d1 c1 b_fR2[of α a] by blast
have "sp α ∈ spth (Restr r (W α)) (re1 α) (ep α)" using c1 b_sp by blast
then have "sp α 0 = re1 α" and "∀i<spl α. (sp α i, sp α (Suc i)) ∈ Restr r (W α)"
unfolding spth_def spl_def rpth_def by blast+
then have d3: "(re1 α, a) ∈ (Restr r (W α))^*"
using d2 lem_rseq_hd unfolding spth_def rpth_def by metis
have "(a, re0 α) ∈ (R α)^*" using d1 unfolding R0_def Field_def by force
moreover have "R α ⊆ Restr r (W α)" using c1 a10 unfolding Field_def by fastforce
ultimately have "(a, re0 α) ∈ (Restr r (W α))^*" using rtrancl_mono by blast
then have "(re1 α, re0 α) ∈ (Restr r (W α))^*" using d3 by force
then show "False" using c1 b_re12[of α] by blast
qed
have "R0 α ⊆ R α" unfolding R0_def by blast
then have c5: "single_valued (R0 α)" using c1 a3 a10[of α] unfolding single_valued_def by blast
have c6: "∀ a b c. (a,b) ∈ R2 α ∧ (a,c) ∈ R2 α ⟶ b = c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ R2 α ∧ (a,c) ∈ R2 α"
then obtain k1 k2 where d1: "k1 < spl α ∧ a = sp α k1 ∧ b = sp α (Suc k1)"
and d2: "k2 < spl α ∧ a = sp α k2 ∧ c = sp α (Suc k2)"
unfolding R2_def by blast
then have "sp α k1 = sp α k2 ∧ k1 ≤ spl α ∧ k2 ≤ spl α" by force
moreover have "inj_on (sp α) {i. i≤spl α}"
using c1 b_sp[of α] lem_spth_inj[of "sp α"] unfolding spl_def by blast
ultimately have "k1 = k2" unfolding inj_on_def by blast
then show "b = c" using d1 d2 by blast
qed
have "single_valued (R0 α ∪ {(re0 α, re1 α)})"
using c2 c5 unfolding single_valued_def by blast
moreover have "single_valued (R2 α ∪ {(re0 α, re1 α)})"
using c3 c6 unfolding single_valued_def by blast
ultimately show "single_valued (R' α)" using c4 lem_sv_un3 unfolding R'_def by blast
qed
have b_acR': "⋀ α. α ∈ S ⟹ acyclic (R' α)"
proof -
fix α
assume c1: "α ∈ S"
obtain s where c2: "s = R0 α ∪ {(re0 α, re1 α)}" by blast
then have "s ⊆ R α" using c1 b_re12[of α] unfolding R0_def by blast
moreover have "acyclic (R α)" using c1 a3 a10 by blast
ultimately have "acyclic s" using acyclic_subset by blast
moreover have "acyclic (R2 α)"
proof -
have "∀ a. (a,a) ∈ (R2 α)^+ ⟶ False"
proof (intro allI impI)
fix a
assume "(a,a) ∈ (R2 α)^+"
then obtain n where e1: "n > 0 ∧ (a,a) ∈ (R2 α)^^n" using trancl_power by blast
then obtain g where e2: "g 0 = a ∧ g n = a" and e3: "∀ i<n. (g i, g (Suc i)) ∈ R2 α"
using relpow_fun_conv[of a a n "R2 α"] by blast
then have "(g 0, g (Suc 0)) ∈ R2 α" using e1 by force
then obtain k0 where e4: "k0 < spl α ∧ g 0 = sp α k0" unfolding R2_def by blast
have e5: "inj_on (sp α) {i. i≤spl α}"
using c1 b_sp[of α] lem_spth_inj[of "sp α"] unfolding spl_def by blast
have "∀ i≤n. k0 + i ≤ spl α ∧ g i = sp α (k0 + i)"
proof
fix i
show "i ≤ n ⟶ k0 + i ≤ spl α ∧ g i = sp α (k0 + i)"
proof (induct i)
show "0 ≤ n ⟶ k0 + 0 ≤ spl α ∧ g 0 = sp α (k0 + 0)" using e4 by simp
next
fix i
assume g1: "i ≤ n ⟶ k0 + i ≤ spl α ∧ g i = sp α (k0 + i)"
show "Suc i ≤ n ⟶ k0 + Suc i ≤ spl α ∧ g (Suc i) = sp α (k0 + Suc i)"
proof
assume h1: "Suc i ≤ n"
then have h2: "k0 + i ≤ spl α ∧ g i = sp α (k0 + i)" using g1 by simp
moreover have "(g i, g (Suc i)) ∈ R2 α" using h1 e3 by simp
ultimately obtain k where
h3: "k < spl α ∧ sp α (k0 + i) = sp α k ∧ g (Suc i) = sp α (Suc k)"
unfolding R2_def by fastforce
then have h4: "k0 + i = k" using h2 h3 e5 unfolding inj_on_def by simp
then have "k0 + Suc i ≤ spl α" using h3 by simp
moreover have "g (Suc i) = sp α (k0 + Suc i)" using h3 h4 by simp
ultimately show "k0 + Suc i ≤ spl α ∧ g (Suc i) = sp α (k0 + Suc i)" by blast
qed
qed
qed
then have "k0 + n ≤ spl α ∧ a = sp α (k0 + n)" using e2 by simp
moreover have "k0 ≤ spl α ∧ a = sp α k0" using e2 e4 by simp
ultimately have "k0 + n = k0" using e5 unfolding inj_on_def by blast
then show "False" using e1 by simp
qed
then show ?thesis unfolding acyclic_def by blast
qed
moreover have "∀ a ∈ (Range (R2 α)) ∩ (Domain s). False"
proof
fix a
assume e1: "a ∈ (Range (R2 α)) ∩ (Domain s)"
then have e2: "a ∈ Field (R0 α) ∨ a = re0 α" using c2 unfolding Field_def by blast
obtain k where e3: "k ≤ spl α ∧ a = sp α k" using e1 c1 b_fR2[of α a] unfolding Field_def by blast
have "sp α ∈ spth (Restr r (W α)) (re1 α) (ep α)" using c1 b_sp by blast
then have "sp α 0 = re1 α" and "∀i<spl α. (sp α i, sp α (Suc i)) ∈ Restr r (W α)"
unfolding spth_def spl_def rpth_def by blast+
then have e4: "(re1 α, a) ∈ (Restr r (W α))^*"
using e3 lem_rseq_hd unfolding spth_def rpth_def by metis
have "(a, re0 α) ∈ (R α)^*" using e2 unfolding R0_def Field_def by force
moreover have "R α ⊆ Restr r (W α)" using c1 a10 unfolding Field_def by fastforce
ultimately have "(a, re0 α) ∈ (Restr r (W α))^*" using rtrancl_mono by blast
then have "(re1 α, re0 α) ∈ (Restr r (W α))^*" using e4 by force
then show "False" using c1 b_re12[of α] by blast
qed
moreover have "R' α = R2 α ∪ s" using c2 unfolding R'_def by blast
ultimately show "acyclic (R' α)" using lem_acyc_un_emprd[of "R2 α" s] by force
qed
have b_dr': "⋀ α. α ∈ S ⟹ Domain (R' α) ∩ Domain re' = {}"
proof -
fix α
assume c1: "α ∈ S"
have "∀ a b c. (a,b) ∈ (R' α) ∧ (a,c) ∈ re' ⟶ False"
proof (intro allI impI)
fix a b c
assume d1: "(a,b) ∈ (R' α) ∧ (a,c) ∈ re'"
then obtain α' where d2: "α' ∈ S ∧ a = ep α'" unfolding re'_def by blast
then have "a ∈ W α'" using b_ep[of α'] unfolding EP_def by blast
moreover have "a ∈ W α" using d1 c1 b_fR'[of α] unfolding Field_def by blast
ultimately have "α' = α" using d2 c1 a9 by blast
then have "a = ep α" using d2 by blast
moreover have "(b, ep α) ∈ (R' α)^*" using d1 c1 b_clR' unfolding Field_def by blast
ultimately have "(a, a) ∈ (R' α)^+" using d1 by force
then show "False" using c1 b_acR' unfolding acyclic_def by blast
qed
then show "Domain (R' α) ∩ Domain re' = {}" by blast
qed
have b_pkr': "⋀ a b1 b2. (a,b1) ∈ r' ∧ (a,b2) ∈ r' ∧ b1 ≠ b2 ⟹ ∀ b. (a,b) ∈ r' ⟶ (a,b) ∈ re'"
proof -
fix a b1 b2
assume c1: "(a,b1) ∈ r' ∧ (a,b2) ∈ r' ∧ b1 ≠ b2"
moreover have "∀α∈S. ∀β∈S. (a,b1) ∈ R' α ∧ (a,b2) ∈ R' β ⟶ False"
proof (intro ballI impI)
fix α β
assume "α ∈ S" and "β ∈ S" and "(a,b1) ∈ R' α ∧ (a,b2) ∈ R' β"
moreover then have "α = β" using b_fR'[of α] b_fR'[of β] a9 unfolding Field_def by blast
ultimately show "False" using c1 b_svR'[of α] unfolding single_valued_def by blast
qed
ultimately have "(a,b1) ∈ re' ∨ (a,b2) ∈ re'" unfolding r'_def by blast
then have "∀ α∈S. a ∉ Domain (R' α)" using b_dr' by blast
then show "∀ b. (a,b) ∈ r' ⟶ (a,b) ∈ re'" using c1 unfolding r'_def by blast
qed
have "r' ⊆ r"
proof
fix p
assume "p ∈ r'"
moreover have "∀ α ∈ S. p ∈ R' α ⟶ p ∈ r"
proof (intro ballI impI)
fix α
assume d1: "α ∈ S" and "p ∈ R' α"
moreover have "p ∈ R0 α ⟶ p ∈ r" unfolding R0_def using d1 a10 by blast
moreover have "p ∈ R2 α ⟶ p ∈ r"
proof
assume "p ∈ R2 α"
then obtain k where "k<spl α ∧ p = (sp α k, sp α (Suc k))" unfolding R2_def by blast
then have "p ∈ Restr r (W α)" using d1 b_sp[of α] unfolding spth_def rpth_def spl_def by blast
then show "p ∈ r" by blast
qed
moreover have "(re0 α, re1 α) ∈ r" using d1 b_re12 a10 by blast
ultimately show "p ∈ r" unfolding R'_def by blast
qed
ultimately show "p ∈ r" unfolding r'_def re'_def by blast
qed
moreover have "∀a∈Field r. ∃b∈Field r'. (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain α where c1: "α ∈ S ∧ a ∈ W α" using a8 by blast
then obtain a' where c2: "(a, a') ∈ (Restr r (W α))^*"
and c3: "∀β∈S. α <o β ⟶ r``{a'} ∩ W β ≠ {}" using a11[of α a] by blast
have "a' ∈ W α" using c1 c2 lem_rtr_field[of a a'] unfolding Field_def by blast
then have "a' ∈ EP α" using c3 unfolding EP_def by blast
then obtain γ a'' where c4: "γ ∈ S" and c5: "a'' ∈ W γ ∧ (a', a'') ∈ r ∧ (a'', h γ) ∈ (R γ)^*"
using c1 b_h[of α α a' a'] by blast
moreover then have "(a'', h γ) ∈ r^*" using p1 rtrancl_mono[of "R γ" r] by blast
moreover have "(a, a') ∈ r^*" using c2 rtrancl_mono[of "Restr r (W α)" r] by blast
ultimately have "(a, h γ) ∈ r^*" by force
moreover have "h γ ∈ W γ" using c4 c5 b_r0w by blast
moreover then have "h γ ∈ Field r'" using c4 b_hf by blast
ultimately show "∃b∈Field r'. (a, b) ∈ r^*" by blast
qed
moreover have "DCR 2 r' ∧ CCR r'"
proof -
obtain g0 where c1: "g0 = { (u,v) ∈ r'. r'``{u} = {v} }" by blast
obtain g1 where c2: "g1 = r' - g0" by blast
obtain g where c3: "g = (λn::nat. (if (n=0) then g0 else (if (n=1) then g1 else {})))" by blast
have c4: "∀ β ∈ S. R' β ⊆ g0"
proof
fix β
assume d1: "β ∈ S"
then have "R' β ⊆ r'" unfolding r'_def by blast
moreover have "∀ a b c. (a,b) ∈ R' β ∧ (a,c) ∈ r' ⟶ b = c"
proof (intro allI impI)
fix a b c
assume e1: "(a, b) ∈ R' β ∧ (a, c) ∈ r'"
moreover then have "(a,b) ∈ r'" using d1 unfolding r'_def by blast
ultimately have "b = c ∨ (a, b) ∈ re'" using b_pkr'[of a b c] by blast
moreover have "(a,b) ∈ re' ⟶ False" using e1 d1 b_dr'[of β] by blast
ultimately show "b = c" by blast
qed
ultimately show "R' β ⊆ g0" using c1 by blast
qed
have c5: "re' ⊆ g1"
proof -
have "re' ⊆ r'" unfolding r'_def by blast
moreover have "∀ a b. (a,b) ∈ re' ∧ (a,b) ∈ g0 ⟶ False"
proof (intro allI impI)
fix a b
assume e1: "(a,b) ∈ re' ∧ (a,b) ∈ g0"
then obtain α where e2: "α ∈ S ∧ a = ep α" unfolding re'_def by blast
then have e3: "a ∈ EP α" using b_ep by blast
obtain γ1 a1 where e4: "γ1 ∈ S ∧ α <o γ1 ∧ a1 ∈ W γ1 ∧ (a,a1) ∈ re'"
using e2 e3 b_h[of α α a a] b_bhf re'_def by blast
then have "γ1 ∈ S ∧ ep γ1 ∈ EP γ1" using b_ep by blast
then obtain γ2 a2 where e5: "γ2 ∈ S ∧ γ1 <o γ2 ∧ a2 ∈ W γ2 ∧ (a,a2) ∈ re'"
using e2 e3 b_h[of α γ1 a "ep γ1"] re'_def by blast
then have "γ1 ≠ γ2" using ordLess_irrefl unfolding irrefl_def by blast
then have "a1 ≠ a2" using e4 e5 a9 by blast
moreover have "a1 ∈ r'``{a} ∧ a2 ∈ r'``{a}" using e4 e5 unfolding r'_def by blast
moreover have "r'``{a} = {b}" using e1 c1 by blast
ultimately have "a1 ∈ {b} ∧ a2 ∈ {b} ∧ a1 ≠ a2" by blast
then show "False" by blast
qed
ultimately show ?thesis using c2 by force
qed
have "r' = ⋃{r'. ∃α'<2. r' = g α'}"
proof
have "r' ⊆ g0 ∪ g1" using c1 c2 by blast
moreover have "g0 = g 0 ∧ g1 = g 1 ∧ (0::nat) < 2 ∧ (1::nat) < 2" using c3 by simp
ultimately show "r' ⊆ ⋃{r'. ∃α'<2. r' = g α'}" by blast
next
have "⋀ α. g α ⊆ g0 ∪ g1" unfolding c3 by simp
then show "⋃{r'. ∃α'<2. r' = g α'} ⊆ r'" using c1 c2 by blast
qed
moreover have "∀l1 l2 u v w. l1 ≤ l2 ⟶ (u, v) ∈ g l1 ∧ (u, w) ∈ g l2 ⟶
(∃v' v'' w' w'' d. (v, v', v'', d) ∈ 𝔇 g l1 l2 ∧ (w, w', w'', d) ∈ 𝔇 g l2 l1)"
proof (intro allI impI)
fix l1 l2 u v w
assume d1: "l1 ≤ l2" and d2: "(u, v) ∈ g l1 ∧ (u, w) ∈ g l2"
have d3: "g0 = g 0 ∧ g1 = g 1"
and d4: "∀ α. g α ≠ {} ⟶ α = 0 ∨ α = 1" unfolding c3 by simp+
have d5: "𝔏1 g 1 = g0" and d6: "𝔏v g 1 1 = g0"
and d7: "𝔏v g 1 0 = g0" and d8: "𝔏v g 0 1 = g0" using d3 unfolding 𝔏1_def 𝔏v_def by blast+
show "∃v' v'' w' w'' d. (v, v', v'', d) ∈ 𝔇 g l1 l2 ∧ (w, w', w'', d) ∈ 𝔇 g l2 l1"
proof -
have "l1 = 0 ∧ l2 = 0 ⟹ ?thesis"
proof -
assume "l1 = 0 ∧ l2 = 0"
then have "r'``{u} = {v} ∧ r'``{u} = {w}" using c1 d2 d3 by blast
then have "v = w" by blast
then show ?thesis unfolding 𝔇_def by fastforce
qed
moreover have "l1 = 0 ∧ l2 = 1 ⟹ False"
proof -
assume "l1 = 0 ∧ l2 = 1"
then have "(u, v) ∈ r' ∧ (u, w) ∈ r'"
and "r'``{u} = {v} ∧ r'``{u} ≠ {w}" using c1 c2 d2 d3 by blast+
then show "False" by force
qed
moreover have "l1 = 1 ∧ l2 = 1 ⟹ ?thesis"
proof -
assume f1: "l1 = 1 ∧ l2 = 1"
then have "(u,v) ∈ g1 ∧ (u,w) ∈ g1" using d2 d3 by blast
then have "(u,v) ∈ re' ∧ (u,w) ∈ re'" using c1 c2 b_pkr' by blast
then obtain β1 β2 where f2: "β1 ∈ S ∧ β2 ∈ S"
and "v ∈ W β1 ∧ (v, h β1) ∈ (R β1)^*"
and "w ∈ W β2 ∧ (w, h β2) ∈ (R β2)^*" unfolding re'_def by blast
then have "v ∈ Field (R' β1) ∧ w ∈ Field (R' β2)" using b_bhf by blast
then have f3: "(v, ep β1) ∈ (R' β1)^* ∧ (w, ep β2) ∈ (R' β2)^*" using f2 b_clR' by blast
then have "ep β1 ∈ EP β1 ∧ ep β2 ∈ EP β2" using f2 b_ep by blast
then obtain γ v'' w'' where f4: "γ ∈ S ∧ β1 <o γ ∧ β2 <o γ"
and "v'' ∈ W γ ∧ (ep β1, v'') ∈ r ∧ (v'', h γ) ∈ (R γ)^*"
and "w'' ∈ W γ ∧ (ep β2, w'') ∈ r ∧ (w'', h γ) ∈ (R γ)^*"
using f2 b_h[of β1 β2 "ep β1" "ep β2"] by blast
then have "(ep β1, v'') ∈ re' ∧ (ep β2, w'') ∈ re'"
and "(v'', ep γ) ∈ (R' γ)^* ∧ (w'', ep γ) ∈ (R' γ)^*"
using f2 b_bhf b_clR' unfolding re'_def by blast+
moreover obtain v' w' d where "v' = ep β1 ∧ w' = ep β2 ∧ d = ep γ" by blast
ultimately have f5: "(v, v') ∈ (R' β1)^* ∧ (v', v'') ∈ re' ∧ (v'', d) ∈ (R' γ)^*"
and f6: "(w, w') ∈ (R' β2)^* ∧ (w', w'') ∈ re' ∧ (w'', d) ∈ (R' γ)^*"
using f3 by blast+
have "(R' β1)^* ⊆ (𝔏1 g l1)^*" using f1 f2 d5 c4 rtrancl_mono by blast
moreover have "re' ⊆ g l2" using f1 d3 c5 by blast
moreover have "(R' γ)^* ⊆ (𝔏v g l1 l2)^*" using f1 f4 d6 c4 rtrancl_mono by blast
moreover have "(R' β2)^* ⊆ (𝔏1 g l2)^*" using f1 f2 d5 c4 rtrancl_mono by blast
moreover have "re' ⊆ g l1" using f1 d3 c5 by blast
moreover have "(R' γ)^* ⊆ (𝔏v g l2 l1)^*" using f1 f4 d6 c4 rtrancl_mono by blast
ultimately have "(v, v', v'', d) ∈ 𝔇 g l1 l2 ∧ (w, w', w'', d) ∈ 𝔇 g l2 l1 "
using f5 f6 unfolding 𝔇_def by blast
then show ?thesis by blast
qed
moreover have "(l1 = 0 ∨ l1 = 1) ∧ (l2 = 0 ∨ l2 = 1)" using d2 d4 by blast
ultimately show ?thesis using d1 by fastforce
qed
qed
ultimately have c9: "DCR 2 r'" using lem_Ldo_ldogen_ord unfolding DCR_def by blast
have "∀a∈Field r'. ∀b∈Field r'. ∃c ∈ Field r'. (a,c) ∈ r'^* ∧ (b,c) ∈ r'^*"
proof (intro ballI impI)
fix a b
assume d1: "a ∈ Field r'" and d2: "b ∈ Field r'"
obtain α β where d3: "α ∈ S ∧ β ∈ S"
and d4: "(a, ep α) ∈ (R' α)^* ∧ (b, ep β) ∈ (R' β)^*" using d1 d2 b_epr' by blast
then have "ep α ∈ EP α ∧ ep β ∈ EP β" using b_ep by blast
then obtain γ a' b' where d5: "γ ∈ S ∧ α <o γ ∧ β <o γ"
and d6: "a' ∈ W γ ∧ (ep α, a') ∈ r ∧ (a', h γ) ∈ (R γ)^*"
and d7: "b' ∈ W γ ∧ (ep β, b') ∈ r ∧ (b', h γ) ∈ (R γ)^*"
using d3 b_h[of α β "ep α" "ep β"] by blast
then have "(a', ep γ) ∈ (R' γ)^* ∧ (b', ep γ) ∈ (R' γ)^*" using b_bhf b_clR' by blast
moreover have "R' α ⊆ r' ∧ R' β ⊆ r' ∧ R' γ ⊆ r'" using d3 d5 unfolding r'_def by blast
ultimately have "(a, ep α) ∈ r'^* ∧ (b, ep β) ∈ r'^*"
and "(a', ep γ) ∈ r'^* ∧ (b', ep γ) ∈ r'^*" using d4 rtrancl_mono by blast+
moreover have "(ep α, a') ∈ r'" using d3 d5 d6 unfolding r'_def re'_def by blast
moreover have "(ep β, b') ∈ r'" using d3 d5 d7 unfolding r'_def re'_def by blast
ultimately have "(a, ep γ) ∈ r'^* ∧ (b, ep γ) ∈ r'^*" by force
moreover then have "ep γ ∈ Field r'" using d1 lem_rtr_field by metis
ultimately show "∃c ∈ Field r'. (a,c) ∈ r'^* ∧ (b,c) ∈ r'^*" by blast
qed
then have "CCR r'" unfolding CCR_def by blast
then show ?thesis using c9 by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_uset_cl_ext:
fixes r::"'U rel" and s::"'U rel"
assumes "s ∈ 𝔘 r" and "Conelike s"
shows "Conelike r"
proof (cases "s = {}")
assume "s = {}"
then have "r = {}" using assms unfolding 𝔘_def Field_def by fast
then show "Conelike r" unfolding Conelike_def by blast
next
assume "s ≠ {}"
then obtain m where "m ∈ Field s ∧ (∀ a ∈ Field s. (a,m) ∈ s^*)" using assms unfolding Conelike_def by blast
moreover have "s ⊆ r ∧ (∀ a ∈ Field r. ∃ b ∈ Field s. (a,b) ∈ r^*)" using assms unfolding 𝔘_def by blast
moreover then have "Field s ⊆ Field r ∧ s^* ⊆ r^*" unfolding Field_def using rtrancl_mono by blast
ultimately have "(m ∈ Field r) ∧ (∀ a ∈ Field r. (a,m) ∈ r^*)" by (meson rtrancl_trans subsetCE)
then show "Conelike r" unfolding Conelike_def by blast
qed
lemma lem_uset_cl_singleton:
fixes r::"'U rel"
assumes "Conelike r" and "r ≠ {}"
shows "∃ m::'U. ∃ m'::'U. {(m',m)} ∈ 𝔘 r"
proof -
obtain m where b1: "m ∈ Field r ∧ (∀ a ∈ Field r. (a,m) ∈ r^*)" using assms unfolding Conelike_def by blast
then obtain x where b2: "(m,x) ∈ r ∨ (x,m) ∈ r" unfolding Field_def by blast
then have "(x,m) ∈ r^*" using b1 unfolding Field_def by blast
then obtain m' where b3: "(m',m) ∈ r" using b2 by (metis rtranclE)
have "CCR {(m',m)}" unfolding CCR_def Field_def by force
moreover have "∀a∈Field r. ∃b∈Field {(m',m)}. (a, b) ∈ r^*" using b1 unfolding Field_def by blast
ultimately show ?thesis using b3 unfolding 𝔘_def by blast
qed
lemma lem_rcc_emp: "∥{}∥ = {}"
unfolding RCC_def RCC_rel_def 𝔘_def apply simp
unfolding CCR_def apply simp
using lem_card_emprel by (smt iso_ozero_empty ordIso_symmetric ozero_def someI_ex)
lemma lem_rcc_rccrel:
fixes r::"'U rel"
shows "RCC_rel r ∥r∥"
proof -
have "∃ α. RCC_rel r α"
proof (cases "𝔘 r = {}")
assume "𝔘 r = {}"
then show "∃ α. RCC_rel r α" unfolding RCC_rel_def by blast
next
assume b1: "𝔘 r ≠ {}"
obtain Q where b2: "Q = { α::'U rel. ∃ s ∈ 𝔘 r. α =o |s| }" by blast
have b3: "∀ s ∈ 𝔘 r. ∃ α ∈ Q. α ≤o |s|"
proof
fix s
assume c1: "s ∈ 𝔘 r"
then have c2: "s ⊆ (UNIV::'U set) × (UNIV::'U set)" unfolding 𝔘_def by simp
then have c3: "|s| ≤o |(UNIV::'U set) × (UNIV::'U set)|" by simp
show "∃ α ∈ Q. α ≤o |s|"
proof (cases "finite (UNIV::'U set)")
assume "finite (UNIV::'U set)"
then have "finite s" using c2 finite_subset by blast
moreover have "CCR s" using c1 unfolding 𝔘_def by blast
ultimately have "Conelike s" using lem_Relprop_fin_ccr by blast
then have d1: "Conelike r" using c1 lem_uset_cl_ext by blast
show "∃ α ∈ Q. α ≤o |s|"
proof (cases "r = {}")
assume e1: "r = {}"
obtain α where e2: "α = ({}::'U rel)" by blast
then have "α ∈ 𝔘 r" using e1 unfolding 𝔘_def CCR_def Field_def by blast
moreover have e3: "α =o |({}::'U rel)|" using e2 lem_card_emprel ordIso_symmetric by blast
ultimately have "α ∈ Q" using b2 e2 by blast
moreover have "α ≤o |s|" using e3 card_of_empty ordIso_ordLeq_trans by blast
ultimately show "∃ α ∈ Q. α ≤o |s|" by blast
next
assume e1: "r ≠ {}"
then obtain m m' where e2: "{(m',m)} ∈ 𝔘 r" using d1 lem_uset_cl_singleton by blast
obtain α where e3: "α = |{m}|" by blast
then have "α =o |{(m',m)}|" by (simp add: ordIso_iff_ordLeq)
then have "α ∈ Q" using b2 e2 by blast
moreover have "s ≠ {}" using c1 e1 unfolding 𝔘_def Field_def by force
moreover then have "α ≤o |s|" using e3 by simp
ultimately show "∃ α ∈ Q. α ≤o |s|" by blast
qed
next
assume "¬ finite (UNIV::'U set)"
then have "|(UNIV::'U set) × (UNIV::'U set)| =o |UNIV::'U set|" using card_of_Times_same_infinite by blast
then have "|s| ≤o |UNIV::'U set|" using c3 using ordLeq_ordIso_trans by blast
then obtain A::"'U set" where "|s| =o |A|" using internalize_card_of_ordLeq2 by fast
moreover then obtain α::"'U rel" where "α = |A|" by blast
ultimately have "α ∈ Q ∧ α =o |s|" using b2 c1 ordIso_symmetric by blast
then show "∃ α ∈ Q. α ≤o |s|" using ordIso_iff_ordLeq by blast
qed
qed
then have "Q ≠ {}" using b1 by blast
then obtain α where b4: "α ∈ Q ∧ (∀α'. α' <o α ⟶ α' ∉ Q)" using wf_ordLess wf_eq_minimal[of "ordLess"] by blast
moreover have "∀ α' ∈ Q. Card_order α'" using b2 using ordIso_card_of_imp_Card_order by blast
ultimately have "∀ α' ∈ Q. ¬ (α' <o α) ⟶ α ≤o α'" by simp
then have b5: "α ∈ Q ∧ (∀ α' ∈ Q. α ≤o α')" using b4 by blast
then obtain s where b6: "s ∈ 𝔘 r ∧ |s| =o α" using b2 ordIso_symmetric by blast
moreover have "∀ s'∈𝔘 r. |s| ≤o |s'|"
proof
fix s'
assume "s' ∈ 𝔘 r"
then obtain α' where "α' ∈ Q ∧ α' ≤o |s'|" using b3 by blast
moreover then have "|s| =o α ∧ α ≤o α'" using b5 b6 by blast
ultimately show "|s| ≤o |s'|" using ordIso_ordLeq_trans ordLeq_transitive by blast
qed
ultimately have "RCC_rel r α" unfolding RCC_rel_def by blast
then show "∃ α. RCC_rel r α" by blast
qed
then show ?thesis unfolding RCC_def by (metis someI2)
qed
lemma lem_rcc_uset_ne:
assumes "𝔘 r ≠ {}"
shows "∃ s ∈ 𝔘 r. |s| =o ∥r∥ ∧ ( ∀ s' ∈ 𝔘 r. |s| ≤o |s'| )"
using assms lem_rcc_rccrel unfolding RCC_rel_def by blast
lemma lem_rcc_uset_emp:
assumes "𝔘 r = {}"
shows "∥r∥ = {}"
using assms lem_rcc_rccrel unfolding RCC_rel_def by blast
lemma lem_rcc_uset_mem_bnd:
assumes "s ∈ 𝔘 r"
shows "∥r∥ ≤o |s|"
proof -
obtain s0 where "s0 ∈ 𝔘 r ∧ |s0| =o ∥r∥ ∧ ( ∀ s' ∈ 𝔘 r. |s0| ≤o |s'| )" using assms lem_rcc_uset_ne by blast
moreover then have "|s0| ≤o |s|" using assms by blast
ultimately show "∥r∥ ≤o |s|" by (metis ordIso_iff_ordLeq ordLeq_transitive)
qed
lemma lem_rcc_cardord: "Card_order ∥r∥"
proof (cases "𝔘 r = {}")
assume "𝔘 r = {}"
then have "∥r∥ = {}" using lem_rcc_uset_emp by blast
then show "Card_order ∥r∥" using lem_cardord_emp by simp
next
assume "𝔘 r ≠ {}"
then obtain s where "s ∈ 𝔘 r ∧ |s| =o ∥r∥" using lem_rcc_uset_ne by blast
then show "Card_order ∥r∥" using Card_order_ordIso2 card_of_Card_order by blast
qed
lemma lem_uset_ne_rcc_inf:
fixes r::"'U rel"
assumes "¬ ( ∥r∥ <o ω_ord )"
shows "𝔘 r ≠ {}"
proof -
have "∥r∥ = {} ⟶ ∥r∥ <o |UNIV :: nat set|"
by (metis card_of_Well_order finite.emptyI infinite_iff_card_of_nat ordIso_ordLeq_trans ordIso_symmetric ordLeq_iff_ordLess_or_ordIso ozero_def ozero_ordLeq)
then have "∥r∥ = {} ⟶ ∥r∥ <o ω_ord" using card_of_nat ordLess_ordIso_trans by blast
then show "𝔘 r ≠ {}" using assms lem_rcc_uset_emp by blast
qed
lemma lem_rcc_inf: "( ω_ord ≤o ∥r∥ ) = ( ¬ ( ∥r∥ <o ω_ord ) )"
using lem_rcc_cardord lem_cord_lin by (metis Field_natLeq natLeq_card_order)
lemma lem_Rcc_eq1_12:
fixes r::"'U rel"
shows "CCR r ⟹ r ∈ 𝔘 r"
unfolding 𝔘_def CCR_def by blast
lemma lem_Rcc_eq1_23:
fixes r::"'U rel"
assumes "r ∈ 𝔘 r"
shows "(r = ({}::'U rel)) ∨ (({}::'U rel) <o ∥r∥)"
proof -
obtain s0 where a2: "s0 ∈ 𝔘 r" and a3: "|s0| =o ∥r∥" using assms lem_rcc_uset_ne by blast
have "s0 = {} ⟶ r = {}" using a2 unfolding 𝔘_def Field_def by force
moreover have "s0 ≠ {} ⟶ ({}::'U rel) <o ∥r∥"
using a3 lem_rcc_cardord lem_cardord_emp
by (metis (no_types, lifting) Card_order_iff_ordIso_card_of Field_empty
card_of_empty3 card_order_on_well_order_on not_ordLeq_iff_ordLess
ordLeq_iff_ordLess_or_ordIso ordLeq_ordIso_trans ozero_def ozero_ordLeq)
ultimately show ?thesis by blast
qed
lemma lem_Rcc_eq1_31:
fixes r::"'U rel"
assumes "(r = ({}::'U rel)) ∨ (({}::'U rel) <o ∥r∥)"
shows "CCR r"
proof (cases "r = {}")
assume "r = {}"
then show "CCR r" unfolding CCR_def Field_def by blast
next
assume b1: "r ≠ {}"
then have b2: "({}::'U rel) <o ∥r∥" using assms by blast
then have "∥r∥ ≠ ({}::'U rel)" using ordLess_irreflexive by fastforce
then have "𝔘 r ≠ {}" using lem_rcc_uset_emp by blast
then obtain s where b3: "s ∈ 𝔘 r" and b4: "|s| =o ∥r∥" and
b5: "∀ s' ∈ 𝔘 r. |s| ≤o |s'|" using lem_rcc_uset_ne by blast
have "s ≠ {}" using assms b1 b4 lem_card_emprel not_ordLess_ordIso ordIso_ordLess_trans by blast
have "s ⊆ r" using b3 unfolding 𝔘_def by blast
then have "Field s ⊆ Field r ∧ s^* ⊆ r^*" unfolding Field_def using rtrancl_mono by blast
have "∀a∈Field r. ∀b∈Field r. ∃c∈Field r. (a, c) ∈ r^* ∧ (b, c) ∈ r^*"
proof (intro ballI)
fix a b
assume c1: "a ∈ Field r" and c2: "b ∈ Field r"
then obtain a' b' where c3: "a' ∈ Field s ∧ b' ∈ Field s ∧ (a,a') ∈ r^* ∧ (b,b') ∈ r^*"
using b3 unfolding 𝔘_def by blast
then obtain c where c4: "c ∈ Field s ∧ (a',c) ∈ s^* ∧ (b',c) ∈ s^*" using b3 unfolding 𝔘_def CCR_def by blast
have "a' ∈ Field r ∧ b' ∈ Field r ∧ c ∈ Field r" using b3 c3 c4 unfolding 𝔘_def Field_def by blast
moreover have "(a',c) ∈ r^* ∧ (b',c) ∈ r^*" using b3 c4 unfolding 𝔘_def using rtrancl_mono by blast
ultimately have "c ∈ Field r ∧ (a, c) ∈ r^* ∧ (b, c) ∈ r^*" using c3 by force
then show "∃c∈Field r. (a, c) ∈ r^* ∧ (b, c) ∈ r^*" by blast
qed
then show "CCR r" unfolding CCR_def by blast
qed
lemma lem_Rcc_eq2_12:
fixes r::"'U rel" and a::"'a"
assumes "Conelike r"
shows "∥r∥ ≤o |{a}|"
proof (cases "r = {}")
assume "r = {}"
then have "∥r∥ = {}" using lem_rcc_emp by blast
then show "∥r∥ ≤o |{a}|" by (metis card_of_Well_order ozero_def ozero_ordLeq)
next
assume "r ≠ {}"
then obtain m where b1: "m ∈ Field r ∧ (∀ a ∈ Field r. (a,m) ∈ r^*)" using assms unfolding Conelike_def by blast
then obtain m' where b2: "(m,m') ∈ r ∨ (m',m) ∈ r" unfolding Field_def by blast
then have "(m',m) ∈ r^*" using b1 by (meson FieldI2 r_into_rtrancl)
then obtain x where "(x,m) ∈ r" using b2 by (metis rtranclE)
moreover have "CCR {(x,m)}" unfolding CCR_def Field_def by blast
ultimately have "{(x,m)} ∈ 𝔘 r" using b1 unfolding 𝔘_def by simp
then have "∥r∥ ≤o |{(x,m)}|" using lem_rcc_uset_mem_bnd by blast
moreover have "|{(x,m)}| ≤o |{a}|" by simp
ultimately show "∥r∥ ≤o |{a}|" using ordLeq_transitive by blast
qed
lemma lem_Rcc_eq2_23:
fixes r::"'U rel" and a::"'a"
assumes "∥r∥ ≤o |{a}|"
shows "∥r∥ <o ω_ord"
proof -
have "|{a}| <o |UNIV :: nat set|" using finite_iff_cardOf_nat by blast
then show "∥r∥ <o ω_ord" using assms ordLeq_ordLess_trans card_of_nat ordLess_ordIso_trans by blast
qed
lemma lem_Rcc_eq2_31:
fixes r::"'U rel"
assumes "CCR r" and "∥r∥ <o ω_ord"
shows "Conelike r"
proof -
have "r ∈ 𝔘 r" using assms lem_Rcc_eq1_12 by blast
then obtain s where b1: "s ∈ 𝔘 r" and b2: "|s| =o ∥r∥" using lem_rcc_uset_ne by blast
have "|s| <o ω_ord" using assms b2 using ordIso_imp_ordLeq ordLeq_ordLess_trans by blast
then have "finite s" using finite_iff_ordLess_natLeq by blast
moreover have "CCR s" using b1 unfolding 𝔘_def by blast
ultimately have "Conelike s" using lem_Relprop_fin_ccr by blast
then show "Conelike r" using b1 lem_uset_cl_ext by blast
qed
lemma lem_Rcc_range:
fixes r::"'U rel"
shows "∥r∥ ≤o |UNIV::('U set)|"
by (simp add: lem_rcc_cardord)
lemma lem_rcc_nccr:
fixes r::"'U rel"
assumes "¬ (CCR r)"
shows "∥r∥ = {}"
proof -
have "¬ (({}::'U rel) <o ∥r∥)" using assms lem_Rcc_eq1_31[of r] by blast
moreover have "Well_order ({}::'U rel)" using Well_order_empty by blast
moreover have "Well_order ∥r∥" using lem_rcc_cardord unfolding card_order_on_def by blast
ultimately have "∥r∥ ≤o ({}::'U rel)" by simp
then show "∥r∥ = {}" using lem_ord_subemp by blast
qed
lemma lem_Rcc_relcard_bnd:
fixes r::"'U rel"
shows "∥r∥ ≤o |r|"
proof(cases "CCR r")
assume "CCR r"
then show "∥r∥ ≤o |r|" using lem_Rcc_eq1_12 lem_rcc_uset_mem_bnd by blast
next
assume "¬ CCR r"
then have "∥r∥ = {}" using lem_rcc_nccr by blast
then have "∥r∥ ≤o ({}::'U rel)" by (metis card_of_empty ordLeq_Well_order_simp ozero_def ozero_ordLeq)
moreover have "({}::'U rel) ≤o |r|" by (metis card_of_Well_order ozero_def ozero_ordLeq)
ultimately show "∥r∥ ≤o |r|" using ordLeq_transitive by blast
qed
lemma lem_Rcc_inf_lim:
fixes r::"'U rel"
assumes "ω_ord ≤o ∥r∥"
shows "¬( ∥r∥ = {} ∨ isSuccOrd ∥r∥ )"
using assms lem_card_inf_lim lem_rcc_cardord by blast
lemma lem_rcc_uset_ne_ccr:
fixes r::"'U rel"
assumes "𝔘 r ≠ {}"
shows "CCR r"
proof -
obtain s where b1: "s ∈ 𝔘 r" using assms by blast
have "∀a∈Field r. ∀b∈Field r. ∃c∈Field r. (a, c) ∈ r^* ∧ (b, c) ∈ r^*"
proof (intro ballI impI)
fix a b
assume "a∈Field r" and "b∈Field r"
then obtain a' b' where c1: "a' ∈ Field s ∧ b' ∈ Field s ∧ (a,a') ∈ r^* ∧ (b,b') ∈ r^*"
using b1 unfolding 𝔘_def by blast
then obtain c where "c ∈ Field s ∧ (a',c) ∈ s^* ∧ (b',c) ∈ s^*" using b1 unfolding 𝔘_def CCR_def by blast
moreover have "s ⊆ r" using b1 unfolding 𝔘_def by blast
ultimately have "c ∈ Field r ∧ (a',c) ∈ r^* ∧ (b',c) ∈ r^*" using rtrancl_mono unfolding Field_def by blast
moreover then have "(a,c) ∈ r^* ∧ (b,c) ∈ r^*" using c1 by force
ultimately show "∃c∈Field r. (a, c) ∈ r^* ∧ (b, c) ∈ r^*" by blast
qed
then show ?thesis unfolding CCR_def by blast
qed
lemma lem_rcc_uset_tr:
fixes r s t::"'U rel"
assumes a1: "s ∈ 𝔘 r" and a2: "t ∈ 𝔘 s"
shows "t ∈ 𝔘 r"
proof -
have "∀a∈Field r. ∃b∈Field t. (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain b' where "b' ∈ Field s ∧ (a,b') ∈ r^*" using a1 unfolding 𝔘_def by blast
moreover then obtain b where "b ∈ Field t ∧ (b',b) ∈ s^*" using a2 unfolding 𝔘_def by blast
moreover have "s ⊆ r" using a1 unfolding 𝔘_def by blast
ultimately have "b ∈ Field t ∧ (a,b') ∈ r^* ∧ (b',b) ∈ r^*" using rtrancl_mono by blast
then have "b ∈ Field t ∧ (a,b) ∈ r^*" by force
then show "∃b∈Field t. (a, b) ∈ r^*" by blast
qed
then show ?thesis using a1 a2 unfolding 𝔘_def by blast
qed
lemma lem_scf_emp: "scf {} = {}"
unfolding scf_def scf_rel_def SCF_def apply simp
using lem_card_emprel by (smt card_of_empty_ordIso iso_ozero_empty ordIso_symmetric ozero_def someI_ex)
lemma lem_scf_scfrel:
fixes r::"'U rel"
shows "scf_rel r (scf r)"
proof -
have b1: "SCF r ≠ {}" unfolding SCF_def by blast
obtain Q where b2: "Q = { α::'U rel. ∃ A ∈ SCF r. α =o |A| }" by blast
have b3: "∀ A ∈ SCF r. ∃ α ∈ Q. α ≤o |A|"
proof
fix A
assume "A ∈ SCF r"
then have "|A| ∈ Q ∧ |A| =o |A|" using b2 ordIso_symmetric by force
then show "∃ α ∈ Q. α ≤o |A|" using ordIso_iff_ordLeq by blast
qed
then have "Q ≠ {}" using b1 by blast
then obtain α where b4: "α ∈ Q ∧ (∀α'. α' <o α ⟶ α' ∉ Q)" using wf_ordLess wf_eq_minimal[of "ordLess"] by blast
moreover have "∀ α' ∈ Q. Card_order α'" using b2 using ordIso_card_of_imp_Card_order by blast
ultimately have "∀ α' ∈ Q. ¬ (α' <o α) ⟶ α ≤o α'" by simp
then have b5: "α ∈ Q ∧ (∀ α' ∈ Q. α ≤o α')" using b4 by blast
then obtain A where b6: "A ∈ SCF r ∧ |A| =o α" using b2 ordIso_symmetric by blast
moreover have "∀ B∈SCF r. |A| ≤o |B|"
proof
fix B
assume "B ∈ SCF r"
then obtain α' where "α' ∈ Q ∧ α' ≤o |B|" using b3 by blast
moreover then have "|A| =o α ∧ α ≤o α'" using b5 b6 by blast
ultimately show "|A| ≤o |B|" using ordIso_ordLeq_trans ordLeq_transitive by blast
qed
ultimately have "scf_rel r α" unfolding scf_rel_def by blast
then show ?thesis unfolding scf_def by (metis someI2)
qed
lemma lem_scf_uset:
shows "∃ A ∈ SCF r. |A| =o scf r ∧ ( ∀ B ∈ SCF r. |A| ≤o |B| )"
using lem_scf_scfrel unfolding scf_rel_def by blast
lemma lem_scf_uset_mem_bnd:
assumes "B ∈ SCF r"
shows "scf r ≤o |B|"
proof -
obtain A where "A ∈ SCF r ∧ |A| =o scf r ∧ ( ∀ A' ∈ SCF r. |A| ≤o |A'| )" using assms lem_scf_uset by blast
moreover then have "|A| ≤o |B|" using assms by blast
ultimately show ?thesis by (metis ordIso_iff_ordLeq ordLeq_transitive)
qed
lemma lem_scf_cardord: "Card_order (scf r)"
proof -
obtain A where "A ∈ SCF r ∧ |A| =o scf r" using lem_scf_uset by blast
then show "Card_order (scf r)" using Card_order_ordIso2 card_of_Card_order by blast
qed
lemma lem_scf_inf: "( ω_ord ≤o (scf r) ) = ( ¬ ( (scf r) <o ω_ord ) )"
using lem_scf_cardord lem_cord_lin by (metis Field_natLeq natLeq_card_order)
lemma lem_scf_eq1_12:
fixes r::"'U rel"
shows "Field r ∈ SCF r"
unfolding SCF_def by blast
lemma lem_scf_range:
fixes r::"'U rel"
shows "(scf r) ≤o |UNIV::('U set)|"
by (simp add: lem_scf_cardord)
lemma lem_scf_relfldcard_bnd:
fixes r::"'U rel"
shows "(scf r) ≤o |Field r|"
using lem_scf_eq1_12 lem_scf_uset_mem_bnd by blast
lemma lem_scf_ccr_scf_rcc_eq:
fixes r::"'U rel"
assumes "CCR r"
shows "∥r∥ =o (scf r)"
proof -
obtain B where b1: "B ∈ SCF r ∧ |B| =o scf r" using lem_scf_scfrel[of r] unfolding scf_rel_def by blast
have "B ⊆ Field r" using b1 unfolding SCF_def by blast
then obtain A where b2: "B ⊆ A ∧ A ∈ SF r"
and b3: "(finite B ⟶ finite A) ∧ ((¬ finite B) ⟶ |A| =o |B| )"
using lem_inv_sf_ext[of B r] by blast
then obtain A' where b4: "A ⊆ A' ∧ A' ∈ SF r ∧ CCR (Restr r A')"
and b5: "(finite A ⟶ finite A') ∧ ((¬ finite A) ⟶ |A'| =o |A| )"
using assms lem_Ccext_subccr_pext5[of r A _ "{}"] by metis
have "Restr r A' ∈ 𝔘 r"
proof -
have "∀a∈Field r. ∃b∈Field (Restr r A'). (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then obtain b where "b ∈ B ∧ (a,b) ∈ r^*" using b1 unfolding SCF_def by blast
moreover then have "b ∈ Field (Restr r A')" using b2 b4 unfolding SF_def by blast
ultimately show "∃b∈Field (Restr r A'). (a, b) ∈ r^*" by blast
qed
then show "Restr r A' ∈ 𝔘 r" unfolding 𝔘_def using b4 by blast
qed
then have b6: "∥r∥ ≤o |Restr r A'|" using lem_rcc_uset_mem_bnd by blast
obtain x0::"'U" where "True" by blast
have b7: "∥r∥ ≤o (scf r)"
proof (cases "finite B")
assume "finite B"
then have "finite (Restr r A')" using b3 b5 by blast
then have "Conelike r"
using assms b6 lem_Rcc_eq2_31[of r] finite_iff_ordLess_natLeq[of "Restr r A'"] ordLeq_ordLess_trans by blast
then have c1: "∥r∥ ≤o |{x0}|" using lem_Rcc_eq2_12[of r x0] by blast
show ?thesis
proof (cases "r = {}")
assume "r = {}"
then have "scf r = {} ∧ ∥r∥ = {}" using lem_scf_emp lem_rcc_emp by blast
then show "∥r∥ ≤o (scf r)" using b1 lem_ord_subemp ordIso_iff_ordLeq by metis
next
assume "r ≠ {}"
then have "B ≠ {}" using b1 unfolding SCF_def Field_def by force
then have "|{x0}| ≤o |B|" using card_of_singl_ordLeq by metis
then show ?thesis using c1 b1 ordLeq_transitive ordIso_imp_ordLeq by metis
qed
next
assume c1: "¬ finite B"
then have "|A| =o |B| ∧ |A'| =o |A|" using b3 b5 finite_subset by simp
then have "|A'| =o scf r" using b1 using ordIso_transitive by blast
moreover have "ω_ord ≤o scf r" using c1 b1 infinite_iff_natLeq_ordLeq ordLeq_ordIso_trans by blast
ultimately have "|Restr r A'| ≤o scf r" using lem_restr_ordbnd[of "scf r" A' r] ordIso_imp_ordLeq by blast
then show "∥r∥ ≤o (scf r)" using b6 ordLeq_transitive by blast
qed
moreover have "(scf r) ≤o ∥r∥"
proof -
obtain s where b1: "s ∈ 𝔘 r ∧ |s| =o ∥r∥ ∧ (∀s'∈𝔘 r. |s| ≤o |s'| )"
using assms lem_Rcc_eq1_12[of r] lem_rcc_uset_ne[of r] by blast
then have "Field s ⊆ Field r ∧ (∀a∈Field r. ∃b∈Field s. (a, b) ∈ r^*)"
unfolding 𝔘_def Field_def by blast
then have "Field s ∈ SCF r" unfolding SCF_def by blast
then have b2: "scf r ≤o |Field s|" using lem_scf_uset_mem_bnd by blast
show ?thesis
proof (cases "finite s")
assume "finite s"
then have "∥r∥ <o ω_ord"
using b1 finite_iff_ordLess_natLeq not_ordLeq_ordLess ordIso_iff_ordLeq ordIso_transitive ordLeq_iff_ordLess_or_ordIso ordLeq_transitive by metis
then have c1: "Conelike r" using assms lem_Rcc_eq2_31 by blast
show ?thesis
proof (cases "r = {}")
assume "r = {}"
then have "scf r = {} ∧ ∥r∥ = {}" using lem_scf_emp lem_rcc_emp by blast
then show ?thesis using b7 by simp
next
assume d1: "r ≠ {}"
then obtain m where "m ∈ Field r ∧ (∀ a ∈ Field r. (a,m) ∈ r^*)" using c1 unfolding Conelike_def by blast
then have "{m} ∈ SCF r" unfolding SCF_def by blast
then have d2: "scf r ≤o |{m}|" using lem_scf_uset_mem_bnd by blast
have "({}::'U rel) <o ∥r∥" using d1 assms lem_Rcc_eq1_23 lem_Rcc_eq1_12 by blast
then have "|{m}| ≤o ∥r∥" using lem_co_one_ne_min by (metis card_of_empty3 card_of_empty4 insert_not_empty ordLess_Well_order_simp)
then show ?thesis using d2 ordLeq_transitive by blast
qed
next
assume "¬ finite s"
then have "|Field s| =o |s|" using lem_rel_inf_fld_card by blast
then show ?thesis using b1 b2 ordIso_iff_ordLeq ordLeq_transitive by metis
qed
qed
ultimately show ?thesis using not_ordLeq_ordLess ordLeq_iff_ordLess_or_ordIso by blast
qed
lemma lem_scf_ccr_scf_uset:
fixes r::"'U rel"
assumes "CCR r" and "¬ Conelike r"
shows "∃ s ∈ 𝔘 r. (¬ finite s) ∧ |Field s| =o (scf r)"
proof -
have "∥r∥ =o (scf r)" using assms lem_scf_ccr_scf_rcc_eq by blast
moreover then obtain s where b1: "s ∈ 𝔘 r ∧ |s| =o ∥r∥" using assms lem_Rcc_eq1_12 lem_rcc_uset_ne[of r] by blast
moreover have "(¬ finite s) ⟶ |Field s| =o |s|" using lem_rel_inf_fld_card by blast
moreover have "finite s ⟶ False"
proof
assume "finite s"
then have "|s| <o ω_ord" using finite_iff_ordLess_natLeq by blast
then have "∥r∥ <o ω_ord" using b1
by (meson not_ordLess_ordIso ordIso_iff_ordLeq ordIso_transitive ordLeq_iff_ordLess_or_ordIso ordLeq_transitive)
then show "False" using assms lem_Rcc_eq2_31 by blast
qed
ultimately show ?thesis using ordIso_transitive by metis
qed
lemma lem_Scf_scfprops:
fixes r::"'U rel"
shows "( (scf r) ≤o |UNIV::('U set)| ) ∧ ( (scf r) ≤o |Field r| )"
using lem_scf_range lem_scf_relfldcard_bnd by blast
lemma lem_scf_ccr_finscf_cl:
assumes "CCR r"
shows "finite (Field (scf r)) = Conelike r"
proof
assume "finite (Field (scf r))"
then have "finite ∥r∥" using assms lem_scf_ccr_scf_rcc_eq lem_fin_fl_rel ordIso_finite_Field by blast
then have "∥r∥ <o ω_ord" using lem_rcc_cardord lem_fin_fl_rel
by (metis card_of_Field_ordIso finite_iff_ordLess_natLeq ordIso_iff_ordLeq ordLeq_ordLess_trans)
then show "Conelike r" using assms lem_Rcc_eq2_31 by blast
next
assume "Conelike r"
then have "finite (Field ∥r∥)" using lem_Rcc_eq2_12[of r] by (metis Field_card_of finite.emptyI finite_insert ordLeq_finite_Field)
then show "finite (Field (scf r))" using assms lem_scf_ccr_scf_rcc_eq ordIso_finite_Field by blast
qed
lemma lem_sv_uset_sv_span:
fixes r s::"'U rel"
assumes a1: "s ∈ 𝔘 r" and a2: "single_valued s"
shows "∃ r1. r1 ∈ Span r ∧ CCR r1 ∧ single_valued r1 ∧ s ⊆ r1 ∧ (acyclic s ⟶ acyclic r1)"
proof -
have b0: "s ⊆ r" using a1 unfolding 𝔘_def by blast
obtain isd where b3: "isd = (λ a i. ∃ b ∈ Field s. (a, b) ∈ r^^i ∧ (∀ i'. (∃ b ∈ Field s. (a, b) ∈ r^^(i')) ⟶ i ≤ i'))" by blast
obtain d where b4: "d = (λ a. SOME i. isd a i)" by blast
obtain B where b5: "B = (λ a. { a'. (a, a') ∈ r })" by blast
obtain H where b6: "H = (λ a. { a' ∈ B a. ∀ a'' ∈ B a. (d a') ≤ (d a'') })" by blast
obtain D where b7: "D = { a ∈ Field r - Field s. H a ≠ {}}" by blast
obtain h where "h = (λ a. SOME a'. a' ∈ H a)" by blast
then have b8: "∀ a ∈ D. h a ∈ H a" using b7 someI_ex[of "λ a'. a' ∈ H _"] by force
have q1: "⋀ a. a ∈ Field r ⟹ isd a (d a)"
proof -
fix a
assume c1: "a ∈ Field r"
then obtain b where c2: "b ∈ Field s ∧ (a,b) ∈ r^*" using a1 unfolding 𝔘_def by blast
moreover obtain N where c3: "N = {i. ∃ b ∈ Field s. (a, b) ∈ r^^i}" by blast
ultimately have "N ≠ {}" using rtrancl_imp_relpow by blast
then obtain m where "m ∈ N ∧ (∀ i ∈ N. m ≤ i)"
using LeastI[of "λ x. x ∈ N"] Least_le[of "λ x. x ∈ N"] by blast
then have "isd a m" using c2 c3 unfolding b3 by blast
then show "isd a (d a)" using b4 someI_ex by metis
qed
have q2: "⋀ a. B a ≠ {} ⟹ H a ≠ {}"
proof -
fix a
assume "B a ≠ {}"
moreover obtain N where c1: "N = d ` (B a)" by blast
ultimately have "N ≠ {}" by blast
then obtain m where c2: "m ∈ N ∧ (∀ i ∈ N. m ≤ i)"
using LeastI[of "λ x. x ∈ N"] Least_le[of "λ x. x ∈ N"] by blast
then obtain a' where c3: "m = d a' ∧ a' ∈ B a" using c1 by blast
moreover then have "∀ a'' ∈ B a. d a' ≤ d a''" using c1 c2 by force
ultimately have "a' ∈ H a" unfolding b6 by blast
then show "H a ≠ {}" by blast
qed
have q3: "∀ a ∈ Field r - Field s. d a = 1 ∨ d a > 1"
proof
fix a
assume c1: "a ∈ Field r - Field s"
then have "isd a (d a)" using q1 by blast
then obtain b where "b ∈ Field s ∧ (a, b) ∈ r^^(d a)" using b3 by blast
then have "d a = 0 ⟶ False" using c1 by force
then show "d a = 1 ∨ d a > 1" by force
qed
have "Field r - Field s ⊆ D"
proof
fix a
assume c1: "a ∈ Field r - Field s"
moreover have "H a = {} ⟶ False"
proof
assume "H a = {}"
then have "B a = {}" using q2 by blast
moreover obtain b where "b ∈ Field s ∧ (a, b) ∈ r^*" using a1 c1 unfolding 𝔘_def by blast
ultimately have "a ∈ Field s" unfolding b5 by (metis Collect_empty_eq converse_rtranclE)
then show "False" using c1 by blast
qed
ultimately show "a ∈ D" using b7 by blast
qed
then have q4: "D = Field r - Field s" using b5 b6 b7 by blast
have q5: "∀ a ∈ D. d a > 1 ⟶ d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)"
proof (intro ballI impI)
fix a
assume c1: "a ∈ D" and c2: "d a > 1"
then obtain b where c3: "b ∈ Field s" and c4: "(a, b) ∈ r^^(d a)"
and c5: "∀ i'. (∃ b ∈ Field s. (a, b) ∈ r^^(i')) ⟶ (d a) ≤ i'"
using b3 b7 q1 by blast
have c6: "d a ≥ 1" using c1 c4 b7 q3 by force
then have "d a = Suc ((d a) - 1)" by simp
then obtain a' where c7: "(a,a') ∈ r ∧ (a',b) ∈ r^^((d a) - 1)"
using c4 relpow_Suc_D2[of a b "d a - 1" r] by metis
moreover then have "a' ∉ Field s" using c2 c5 by (metis less_Suc_eq_le not_less_eq relpow_1)
ultimately have "(a,a') ∈ r ∧ a' ∈ Field r - Field s" unfolding Field_def by blast
then have "a' ∈ B a" unfolding b5 by blast
moreover have "h a ∈ H a" using c1 b8 by blast
ultimately have "d (h a) ≤ d a'" unfolding b6 by blast
moreover have "Suc (d a') ≤ d a"
proof -
have "d a' ≤ d a - 1" using q1 b3 c7 c3 unfolding Field_def by blast
then show ?thesis using c6 by force
qed
moreover have "d a ≤ (Suc (d (h a)))"
proof -
have d1: "(a, h a) ∈ r" using c1 b5 b6 b8 by blast
then have "h a ∈ Field r" unfolding Field_def by blast
then obtain b' where "b' ∈ Field s ∧ ((h a), b') ∈ r^^(d (h a))" using b3 q1 by blast
moreover then have "(a,b') ∈ r^^(Suc (d (h a)))" using d1 c7 by (meson relpow_Suc_I2)
ultimately show "d a ≤ (Suc (d (h a)))" using c5 by blast
qed
ultimately have "d a = Suc (d (h a))" by force
moreover have "d (h a) > 1 ⟶ h a ∈ D"
proof
assume d1: "d (h a) > 1"
then have d2: "(a, h a) ∈ r" using c1 b5 b6 b8 by simp
then have "isd (h a) (d (h a))" using d1 q1 unfolding Field_def by force
then have "(h a) ∉ Field s" using d1 b3 by force
then show "h a ∈ D" using d2 q4 unfolding Field_def by blast
qed
ultimately show "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" by blast
qed
obtain g1 where b9: "g1 = { (a, b). a ∈ D ∧ b = h a }" by blast
have q6: "∀ a ∈ D. ∃ a' ∈ D. d a' = 1 ∧ (a,a') ∈ g1^*"
proof -
have "∀ n. ∀ a ∈ D. d a = Suc n ⟶ ((h^^n) a) ∈ D ∧ d ((h^^n) a) = 1"
proof
fix n0
show "∀ a ∈ D. d a = Suc n0 ⟶ ((h^^n0) a) ∈ D ∧ d ((h^^n0) a) = 1"
proof (induct n0)
show "∀a∈D. d a = Suc 0 ⟶ ((h^^0) a) ∈ D ∧ d ((h ^^ 0) a) = 1"
using q4 by force
next
fix n
assume d1: "∀a∈D. d a = Suc n ⟶ ((h^^n) a) ∈ D ∧ d ((h ^^ n) a) = 1"
show "∀a∈D. d a = Suc (Suc n) ⟶ ((h^^(Suc n)) a) ∈ D ∧ d ((h ^^ Suc n) a) = 1"
proof (intro ballI impI)
fix a
assume e1: "a ∈ D" and e2: "d a = Suc (Suc n)"
then have "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" using q5 by simp
moreover then have e3: "d (h a) = Suc n" using e2 by simp
ultimately have "d (h a) > 1 ⟶ ((h^^n) (h a)) ∈ D ∧ d ((h^^n) (h a)) = 1" using d1 by blast
moreover have "(h^^n) (h a) = (h^^(Suc n)) a" by (metis comp_apply funpow_Suc_right)
moreover have e4: "d (h a) = 1 ⟶ d ((h^^(Suc n)) a) = 1" using e3 by simp
moreover have "d (h a) = 1 ⟶ ((h^^(Suc n)) a) ∈ D"
proof
assume f1: "d (h a) = 1"
then have f2: "n = 0 ∧ (a, h a) ∈ r" using e1 e3 b5 b6 b8 by simp
then have "isd (h a) 1" using f1 q1 unfolding Field_def by force
then have "(h a) ∉ Field s" using b3 by force
then have "(h a) ∈ D" using q4 f2 unfolding Field_def by blast
then show "((h^^(Suc n)) a) ∈ D" using f2 by simp
qed
moreover have "d (h a) = 1 ∨ d (h a) > 1" using e3 by force
ultimately show "((h^^(Suc n)) a) ∈ D ∧ d ((h ^^ (Suc n)) a) = 1" by force
qed
qed
qed
moreover have "∀ i. ∀ a ∈ D. d a > i ⟶ (a, (h^^i) a) ∈ g1^*"
proof
fix i0
show "∀ a ∈ D. d a > i0 ⟶ (a, (h^^i0) a) ∈ g1^*"
proof (induct i0)
show "∀a∈D. d a > 0 ⟶ (a, (h^^0) a) ∈ g1^*" by force
next
fix i
assume d1: "∀a∈D. d a > i ⟶ (a, (h^^i) a) ∈ g1^*"
show "∀a∈D. d a > (Suc i) ⟶ (a, (h^^(Suc i)) a) ∈ g1^*"
proof (intro ballI impI)
fix a
assume e1: "a ∈ D" and e2: "d a > (Suc i)"
then have e3: "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" using q5 by simp
moreover then have e4: "d (h a) > i" using e2 by simp
ultimately have "d (h a) > 1 ⟶ (h a, (h^^i) (h a)) ∈ g1^*" using d1 by simp
moreover have "(h^^i) (h a) = (h^^(Suc i)) a" by (metis comp_apply funpow_Suc_right)
moreover have "d (h a) = 1 ⟶ (h^^(Suc i)) a = (h a)" using e4 by force
moreover have "d (h a) = 1 ∨ d (h a) > 1" using e4 by force
moreover then have "(a, h a) ∈ g1" using e1 e3 unfolding b9 by simp
ultimately show "(a, (h^^(Suc i)) a) ∈ g1^*"
by (metis converse_rtrancl_into_rtrancl r_into_rtrancl)
qed
qed
qed
ultimately have "∀n. ∀a∈D. d a = Suc n ⟶ (h^^n) a ∈ D ∧ d ((h^^n) a) = 1 ∧ (a, (h ^^ n) a) ∈ g1^*"
by simp
then have "∀n. ∀a∈D. d a = Suc n ⟶ (∃ a' ∈ D. d a' = 1 ∧ (a,a') ∈ g1^* )"
by blast
moreover have "∀ a ∈ D. ∃ n. d a = Suc n" using q3 q4 q5 by force
ultimately show ?thesis by blast
qed
obtain r1 where b19: "r1 = s ∪ g1" by blast
have t1: "g1 ⊆ r1" using b19 by blast
have b20: "s ⊆ r1" using b19 by blast
have b21: "r1 ⊆ r"
proof -
have "∀ a ∈ D. (a, h a) ∈ r" using b5 b6 b8 by blast
then have "g1 ⊆ r" using b9 by blast
then show ?thesis using b0 b19 by blast
qed
have b22: "∀a ∈ Field r1 - Field s. ∃b ∈ Field s. (a, b) ∈ r1^*"
proof
fix a
assume d1: "a ∈ Field r1 - Field s"
then have "a ∈ D" using q4 b21 unfolding Field_def by blast
then obtain a' where d2: "a' ∈ D ∧ d a' = 1 ∧ (a, a') ∈ g1^*" using q6 by blast
then have d3: "(a', h a') ∈ r1 ∧ h a' ∈ H a'" using b8 b9 t1 by blast
obtain b where "b ∈ Field s ∧ (a',b) ∈ r" using d2 q1 q4 b3 by force
moreover then have "isd b (d b)" using q1 unfolding Field_def by blast
ultimately have "b ∈ B a' ∧ d b = 0" using b3 b5 by force
then have "d (h a') = 0" using d3 b6 by force
then have "isd (h a') 0" using q1 d3 b21 unfolding Field_def by force
then have "h a' ∈ Field s" using b3 by force
moreover have "(a, a') ∈ r1^*" using d2 t1 rtrancl_mono[of g1 r1] by blast
ultimately have "(h a') ∈ Field s ∧ (a, h a') ∈ r1^*" using d3 by force
then show "∃b ∈ Field s. (a, b) ∈ r1^*" by blast
qed
have b23: "Field r ⊆ Field r1"
proof -
have "(Field r - Field s) ⊆ Field r1" using q4 b9 t1 unfolding Field_def by blast
moreover have "Field s ⊆ Field r1" using b20 unfolding Field_def by blast
ultimately show "Field r ⊆ Field r1" by blast
qed
have "Field r1 ⊆ Field r" using b21 unfolding Field_def by blast
then have "r1 ∈ Span r" using b21 b23 unfolding Span_def by blast
moreover have "CCR r1"
proof -
have "s ∈ 𝔘 r1" using b20 b22 a1 unfolding 𝔘_def by blast
then show "CCR r1" using lem_rcc_uset_ne_ccr by blast
qed
moreover have "single_valued r1"
proof -
have "∀ a b c. (a,b) ∈ r1 ∧ (a,c) ∈ r1 ⟶ b = c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ r1 ∧ (a,c) ∈ r1"
moreover have "(a,b) ∈ s ∧ (a,c) ∈ s ⟶ b = c" using a2 unfolding single_valued_def by blast
moreover have "(a,b) ∈ s ∧ (a,c) ∈ g1 ⟶ False" using b9 b7 unfolding Field_def by blast
moreover have "(a,b) ∈ g1 ∧ (a,c) ∈ s ⟶ b = c" using b9 b7 unfolding Field_def by blast
moreover have "(a,b) ∈ g1 ∧ (a,c) ∈ g1 ⟶ b = c" using b9 by blast
ultimately show "b = c" using b19 by blast
qed
then show ?thesis unfolding single_valued_def by blast
qed
moreover have "acyclic s ⟶ acyclic r1"
proof
assume c1: "acyclic s"
have c2: "∀ a' ∈ D. d a' = 1 ⟶ d (h a') = 0"
proof (intro ballI impI)
fix a'
assume d1: "a' ∈ D" and d2: "d a' = 1"
then have d3: "(a', h a') ∈ r1 ∧ h a' ∈ H a'" using b8 b9 t1 by blast
obtain b where "b ∈ Field s ∧ (a',b) ∈ r" using d1 d2 q1 q4 b3 by force
moreover then have "isd b (d b)" using q1 unfolding Field_def by blast
ultimately have "b ∈ B a' ∧ d b = 0" using b3 b5 by force
then show "d (h a') = 0" using d3 b6 by force
qed
have c3: "∀ a b. (a,b) ∈ g1 ⟶ d b < d a"
proof (intro allI impI)
fix a b
assume "(a,b) ∈ g1"
then have d1: "a ∈ D ∧ b = h a" using b9 by blast
then have "d a > 1 ∨ d a = 1" and "d a > 1 ⟶ d b < d a" using q3 q4 q5 by force+
moreover have "d a = 1 ⟶ d b < d a" using d1 c2 by force
ultimately show "d b < d a" by blast
qed
have c4: "∀ n. ∀ a b. (a,b) ∈ g1^^(Suc n) ⟶ d b < d a"
proof
fix n
show "∀ a b. (a,b) ∈ g1^^(Suc n) ⟶ d b < d a"
proof (induct n)
show "∀a b. (a, b) ∈ g1 ^^ (Suc 0) ⟶ d b < d a" using c3 by force
next
fix n
assume e1: "∀a b. (a, b) ∈ g1 ^^ (Suc n) ⟶ d b < d a"
show "∀a b. (a, b) ∈ g1 ^^ (Suc (Suc n)) ⟶ d b < d a"
proof (intro allI impI)
fix a b
assume "(a, b) ∈ g1 ^^ (Suc (Suc n))"
then obtain c where "(a,c) ∈ g1^^(Suc n) ∧ (c,b) ∈ g1" by force
then have "d c < d a ∧ d b < d c" using e1 c3 by blast
then show "d b < d a" by simp
qed
qed
qed
have "∀ x. (x,x) ∈ g1^+ ⟶ False"
proof (intro allI impI)
fix x
assume "(x,x) ∈ g1^+"
then obtain m::nat where "m > 0 ∧ (x,x) ∈ g1^^m" using trancl_power by blast
moreover then obtain n where "m = Suc n" using less_imp_Suc_add by blast
ultimately have "d x < d x" using c4 by blast
then show "False" by blast
qed
then have "acyclic g1" unfolding acyclic_def by blast
moreover have "∀ a b c. (a,b) ∈ s ∧ (b,c) ∈ g1 ⟶ False" using b9 b7 unfolding Field_def by blast
moreover have "r1 = s ∪ g1" using b19 by blast
ultimately show "acyclic r1" using c1 lem_acyc_un_emprd by blast
qed
ultimately show ?thesis using b20 by blast
qed
lemma lem_incrfun_nat: "∀ i::nat. f i < f (Suc i) ⟹ ∀ i j. i ≤ j ⟶ f i + (j-i) ≤ f j"
proof -
assume a1: "∀ i::nat. f i < f (Suc i)"
have "∀ j. ∀ i. i≤j ⟶ f i + (j-i) ≤ f j"
proof
fix j0
show "∀ i. i≤j0 ⟶ f i + (j0-i) ≤ f j0"
proof (induct j0)
show "∀i≤0. f i + (0 - i) ≤ f 0" by simp
next
fix j
assume c1: "∀i≤j. f i + (j - i) ≤ f j"
show "∀i≤Suc j. f i + (Suc j - i) ≤ f (Suc j)"
proof (intro allI impI)
fix i
assume d1: "i ≤ Suc j"
show "f i + (Suc j - i) ≤ f (Suc j)"
proof (cases "i ≤ j")
assume "i ≤ j"
moreover then have "f i + (j - i) ≤ f j" using c1 by blast
ultimately show ?thesis using a1
by (metis Suc_diff_le Suc_le_eq add_Suc_right not_le order_trans)
next
assume "¬ i ≤ j"
then have "i = Suc j" using d1 by simp
then show ?thesis by simp
qed
qed
qed
qed
then show "∀ i j. i ≤ j ⟶ f i + (j-i) ≤ f j" by blast
qed
lemma lem_sv_uset_rcceqw:
fixes r::"'U rel"
assumes a1: "∥r∥ =o ω_ord"
shows "∃ r1 ∈ 𝔘 r. single_valued r1 ∧ acyclic r1 ∧ (∀ x ∈ Field r1. r1``{x} ≠ {})"
proof -
have "¬ ( ∥r∥ <o ω_ord )" using a1 by (metis not_ordLess_ordIso)
then obtain s where b1: "s ∈ 𝔘 r ∧ |s| =o ∥r∥" using lem_rcc_uset_ne lem_uset_ne_rcc_inf by blast
then have "|Field s| =o ω_ord"
using a1 lem_rel_inf_fld_card[of s] by (metis ordIso_natLeq_infinite1 ordIso_transitive)
then obtain ai where b2: "Field s = ai ` (UNIV::nat set)" using lem_cntset_enum by blast
obtain f where b3: "f = (λ x. SOME y. (x,y) ∈ r^* ∧ y ∈ Field s )" by blast
obtain g where b4: "g = (λ A. SOME y. y ∈ Field r ∧ A ⊆ dncl r {y})" by blast
obtain h where b5: "h = (λ A. SOME y. y ∈ Field r - dncl r A)" by blast
have b6: "⋀ x. x ∈ Field r ⟹ (x, f x) ∈ r^* ∧ f x ∈ Field s"
proof -
fix x
assume "x ∈ Field r"
then have "∃ y. (x,y) ∈ r^* ∧ y ∈ Field s" using b1 unfolding 𝔘_def by blast
then show "(x,f x) ∈ r^* ∧ f x ∈ Field s"
using b3 someI_ex[of "λ y. (x,y) ∈ r^* ∧ y ∈ Field s "] by blast
qed
have b7: "⋀ A. finite A ∧ A ⊆ Field r ⟹ g A ∈ Field r ∧ A ⊆ dncl r {g A}"
proof -
fix A::"'U set"
assume c1: "finite A ∧ A ⊆ Field r"
moreover have "CCR r" using b1 lem_rcc_uset_ne_ccr by blast
ultimately obtain s where c2: "finite s ∧ CCR s ∧ s ⊆ r ∧ A ⊆ Field s"
using lem_Ccext_finsubccr_dext[of r A] by blast
then have c3: "Conelike s" using lem_Relprop_fin_ccr by blast
have "∃ y. y ∈ Field r ∧ A ⊆ dncl r {y}"
proof (cases "A = {}")
assume "A = {}"
moreover have "r ≠ {}" using a1 lem_rcc_emp lem_Rcc_inf_lim by (metis ordIso_iff_ordLeq)
moreover then have "Field r ≠ {}" unfolding Field_def by force
ultimately show ?thesis unfolding dncl_def by blast
next
assume d1: "A ≠ {}"
then have "s ≠ {}" using c2 unfolding Field_def by blast
then obtain y where "∀x∈A. (x, y) ∈ s^*" using c2 c3 unfolding Conelike_def by blast
then have d2: "∀ x ∈ A. (x,y) ∈ r^*" using c2 rtrancl_mono by blast
obtain x0 where "x0 ∈ A ∩ Field r" using d1 c1 c2 by blast
moreover then have "(x0, y) ∈ r^*" using d2 by blast
ultimately have "y ∈ Field r" using lem_rtr_field[of x0 y r] by blast
then show ?thesis using d2 unfolding dncl_def by blast
qed
then show "g A ∈ Field r ∧ A ⊆ dncl r {g A}"
using b4 someI_ex[of "λ y. y ∈ Field r ∧ A ⊆ dncl r {y}"] by blast
qed
have b8: "⋀ A::'U set. finite A ⟹ (h A) ∈ Field r - dncl r A"
proof -
fix A::"'U set"
assume c1: "finite A"
have "Field r - dncl r A = {} ⟶ False"
proof
assume "Field r - dncl r A = {}"
then have "∀ x ∈ Field r. ∃ y ∈ A ∩ Field r. (x,y) ∈ r^*"
using lem_rtr_field[of _ _ r] unfolding dncl_def by blast
then have "A ∩ Field r ∈ SCF r" unfolding SCF_def by blast
then have "scf r ≤o |A ∩ Field r|" using lem_scf_uset_mem_bnd by blast
moreover have "|A ∩ Field r| <o ω_ord" using c1 finite_iff_ordLess_natLeq by blast
ultimately have "scf r <o ω_ord" by (metis ordLeq_ordLess_trans)
moreover have "∥r∥ =o scf r" using b1 lem_scf_ccr_scf_rcc_eq[of r] lem_rcc_uset_ne_ccr[of r] by blast
ultimately show "False" using a1
by (meson not_ordLeq_ordLess ordIso_iff_ordLeq ordLess_ordLeq_trans)
qed
then show "(h A) ∈ Field r - dncl r A"
using b5 someI_ex[of "λ y. y ∈ Field r - dncl r A"] by blast
qed
obtain Ci where b9: "Ci = rec_nat { ai 0 } (λ n B. B ∪ {f(g({(h B)} ∪ B ∪ ai`{k. k≤n}))})" by blast
then have b10: "Ci 0 = {ai 0}"
and b11: "⋀ n. Ci (Suc n) = Ci n ∪ {f(g({(h (Ci n))} ∪ Ci n ∪ ai`{k. k≤n}))}" by simp+
have b12: "Field s ⊆ Field r" using b1 unfolding 𝔘_def Field_def by blast
have b13: "⋀ n. Ci n ⊆ Field s ∧ finite (Ci n)"
proof -
fix n
show "Ci n ⊆ Field s ∧ finite (Ci n)"
proof (induct n)
show "Ci 0 ⊆ Field s ∧ finite (Ci 0)" using b2 b10 by simp
next
fix n
assume "Ci n ⊆ Field s ∧ finite (Ci n)"
moreover then have "{h (Ci n)} ∪ Ci n ∪ ai ` {k. k ≤ n} ⊆ Field r" using b2 b8 b12 by blast
ultimately show "Ci (Suc n) ⊆ Field s ∧ finite (Ci (Suc n))" using b6 b7 b11 by simp
qed
qed
have b14: "⋀ n. ∃ m∈(Ci n). Ci n ∪ ai`{k. k≤n-1} ⊆ dncl r {m}"
proof -
fix n
show "∃ m∈(Ci n). Ci n ∪ ai`{k. k≤n-1} ⊆ dncl r {m}"
proof (induct n)
show "∃m∈Ci 0. Ci 0 ∪ ai`{k. k≤0-1} ⊆ dncl r {m}" using b10 unfolding dncl_def by simp
next
fix n
assume "∃m∈Ci n. Ci n ∪ ai`{k. k≤n-1} ⊆ dncl r {m}"
obtain A where d1: "A = {(h (Ci n))} ∪ Ci n ∪ ai`{k. k≤n}" by blast
obtain m where d2: "m = f(g(A))" by blast
have "finite A ∧ A ⊆ Field r" using d1 b2 b8 b12 b13 by force
then have d3: "g A ∈ Field r ∧ A ⊆ dncl r {g A}" using b7 by blast
then have d4: "(g A, m) ∈ r^* ∧ m ∈ Field s" using d2 b6 by blast
have "m ∈ Ci (Suc n)" using d1 d2 b11 by blast
moreover have "ai`{k. k≤n} ⊆ dncl r {m}" using d1 d3 d4 unfolding dncl_def by force
moreover have "Ci n ⊆ dncl r {m}" using d1 d3 d4 unfolding dncl_def by force
moreover then have "Ci (Suc n) ⊆ dncl r {m}" using d1 d2 b11 unfolding dncl_def by blast
ultimately show "∃m∈Ci (Suc n). Ci (Suc n) ∪ ai`{k. k≤(Suc n)-1} ⊆ dncl r {m}" by force
qed
qed
obtain ci where b15: "ci = (λ n. SOME m. m ∈ Ci n ∧ Ci n ⊆ dncl r {m})" by blast
have b16: "⋀ n. (ci n) ∈ Ci n ∧ Ci n ⊆ dncl r {ci n}"
proof -
fix n
have "∃ m∈(Ci n). Ci n ⊆ dncl r {m}" using b14 by blast
then show "(ci n) ∈ Ci n ∧ Ci n ⊆ dncl r {ci n}"
using b15 someI_ex[of "λ m. m ∈ Ci n ∧ Ci n ⊆ dncl r {m}"] by blast
qed
have b17: "⋀ n. ci (Suc n) ∉ dncl r (Ci n)"
proof -
fix n
obtain A where c1: "A = {(h (Ci n))} ∪ Ci n ∪ ai`{k. k≤n}" by blast
then have c2: "finite A ∧ A ⊆ Field r" using b2 b8[of "Ci n"] b13[of n] b12 by blast
then have c3: "g A ∈ Field r ∧ A ⊆ dncl r {g A}" using b7 by simp
then have "(h (Ci n), g A) ∈ r^*" using c1 unfolding dncl_def by blast
moreover have "(g A, f (g A)) ∈ r^*" using c3 b6[of "g A"] by blast
moreover have "(f (g A), ci (Suc n)) ∈ r^*" using c1 b11 b16 unfolding dncl_def by blast
ultimately have "(h (Ci n), ci (Suc n)) ∈ r^*" by force
moreover have "h (Ci n) ∉ dncl r (Ci n)" using b8[of "Ci n"] b13[of n] by blast
ultimately show "ci (Suc n) ∉ dncl r (Ci n)" unfolding dncl_def
by (meson Image_iff converse_iff rtrancl_trans)
qed
have "∀ n. (ci n, ci (Suc n)) ∈ r^* ∧ ci n ≠ ci (Suc n)"
proof
fix n
have "(ci n, ci (Suc n)) ∈ r^*" using b11 b16 unfolding dncl_def by blast
moreover have "ci n ≠ ci (Suc n)" using b16[of n] b17[of "n"] unfolding dncl_def by fastforce
ultimately show "(ci n, ci (Suc n)) ∈ r^* ∧ ci n ≠ ci (Suc n)" by blast
qed
then obtain l yi where
b18: "∀n. (yi n, yi (Suc n)) ∈ r"
and b19: "∀i j. (i < j) = (l i < l j)"
and b20: "∀i. yi (l i) = ci i"
and b21: "∀i. inj_on yi {k. l i ≤ k ∧ k ≤ l (Suc i)}"
and b22: "∀ k. ∃ i. l i ≤ k ∧ Suc k ≤ l (Suc i)"
using lem_flatseq[of ci r] by blast
obtain r' where b23: "r' = { (x,y). ∃ i. x = yi i ∧ y = yi (Suc i) }" by blast
have b24: "∀ j. ∀ i. i ≤ j ⟶ (yi i, yi j) ∈ r'^*"
proof
fix j
show "∀ i. i ≤ j ⟶ (yi i, yi j) ∈ r'^*"
proof (induct j)
show "∀i ≤ 0. (yi i, yi 0) ∈ r'^*" by blast
next
fix j
assume d1: "∀i ≤ j. (yi i, yi j) ∈ r'^*"
show "∀i ≤ Suc j. (yi i, yi (Suc j)) ∈ r'^*"
proof (intro allI impI)
fix i
assume e1: "i ≤ Suc j"
show "(yi i, yi (Suc j)) ∈ r'^*"
proof (cases "i ≤ j")
assume "i ≤ j"
then have "(yi i, yi j) ∈ r'^*" using d1 by blast
moreover have "(yi j, yi (Suc j)) ∈ r'" using b23 by blast
ultimately show ?thesis by simp
next
assume "¬ i ≤ j"
then have "i = Suc j" using e1 by simp
then show ?thesis using e1 by blast
qed
qed
qed
qed
have b25: "∀ j. (∀ i. i ≤ j ⟶ Ci i ⊆ Ci j)"
proof
fix j
show "∀ i. i ≤ j ⟶ Ci i ⊆ Ci j"
proof (induct j)
show "∀i≤0. Ci i ⊆ Ci 0" by force
next
fix j
assume "∀i≤j. Ci i ⊆ Ci j"
moreover have "Ci j ⊆ Ci (Suc j)" using b11 by blast
ultimately show "∀i≤Suc j. Ci i ⊆ Ci (Suc j)" using le_Suc_eq by fastforce
qed
qed
have b26: "∀ k1 k2. k1 < k2 ⟶ yi k1 = yi k2 ⟶ (∃ i. l i ≤ k1 ∧ k2 ≤ l (i+2))"
proof (intro allI impI)
fix k1::nat and k2::nat
assume d1: "k1 < k2" and d2: "yi k1 = yi k2"
obtain i1 i2 where d3: "l i1 ≤ k1 ∧ Suc k1 ≤ l (Suc i1)"
and d4: "l i2 ≤ k2 ∧ Suc k2 ≤ l (Suc i2)" using b22 by blast
have "i1 = i2 ⟶ False"
proof
assume "i1 = i2"
then have "l i1 ≤ k2 ∧ k2 ≤ l (Suc i1)" using d4 by simp
moreover have "l i1 ≤ k1 ∧ k1 ≤ l (Suc i1)" using d3 by simp
ultimately show "False" using d1 d2 b21 unfolding inj_on_def by blast
qed
moreover have "i2 < i1 ⟶ False"
proof
assume "i2 < i1"
then have "Suc i2 = i1 ∨ Suc i2 < i1" by fastforce
then have "l (Suc i2) = l i1 ∨ l (Suc i2) < l i1" using b19 by blast
then have "l (Suc i2) ≤ l i1" by fastforce
moreover have "l i1 < l (Suc i2)" using d1 d3 d4 by simp
ultimately show "False" by simp
qed
moreover have "Suc i1 < i2 ⟶ False"
proof
assume e1: "Suc i1 < i2"
have "k1 ≤ l (Suc i1) ∧ l i2 ≤ k2" using d3 d4 by force
then have "(yi k1, yi (l (Suc i1))) ∈ r^*" and "(yi (l i2), yi k2) ∈ r^*"
using b18 b23 b24 rtrancl_mono[of r' r] by blast+
then have e2: "(yi k1, ci (Suc i1)) ∈ r^*" and e3: "(ci i2, yi k1) ∈ r^*" using d2 b20 by force+
have "Suc i1 ≤ i2-1 ∧ i2-1 ≤ i2" and "Suc (i2-1) = i2" using e1 by simp+
then have e4: "ci i2 ∉ dncl r (Ci (i2 - 1))" and e5: "ci (Suc i1) ∈ Ci (i2-1)"
using b16[of "Suc i1"] b17[of "i2 - 1"] b25 by fastforce+
have "yi k1 ∉ dncl r (Ci (i2-1))" using e3 e4 unfolding dncl_def
by (meson Image_iff converse_iff rtrancl_trans)
moreover have "yi k1 ∈ dncl r (Ci (i2-1))" using e2 e5 unfolding dncl_def by blast
ultimately show "False" by blast
qed
ultimately have "Suc i1 = i2" by simp
moreover then have "l (Suc i1) = l i2" using b19 by blast
ultimately have "l i1 ≤ k1 ∧ k2 ≤ l (i1 + 2)" using d3 d4 by simp
then show "∃ i. l i ≤ k1 ∧ k2 ≤ l (i+2)" by blast
qed
obtain w where b27: "w = (λ k. k + l ((GREATEST j. l j ≤ k) + 2))" by blast
have b28: "⋀ k. ∀ k'. yi k = yi k' ⟶ k' < Suc (w k)"
proof -
fix k
show "∀ k'. yi k = yi k' ⟶ k' < Suc (w k)"
proof (cases "∃ k' > k. yi k' = yi k")
assume d1: "∃ k' > k. yi k' = yi k"
have d2: "∀ k'. k < k' ⟶ yi k = yi k' ⟶ (∃ i. l i ≤ k ∧ k' ≤ l (i+2))" using b26 by blast
have d3: "∀ i. i ≤ l i"
proof
fix i
show "i ≤ l i"
proof (induct i)
show "0 ≤ l 0" by blast
next
fix i
assume "i ≤ l i"
moreover have "l i < l (Suc i)" using b19 by blast
ultimately show "Suc i ≤ l (Suc i)" by simp
qed
qed
obtain i0 where d4: "i0 = (GREATEST j. l j ≤ k)" by blast
obtain t where d5: "t = k + l (i0+2)" by blast
then have "t ≥ k" by force
moreover have "∀ k'. yi k' = yi k ⟶ k' ≤ t"
proof (intro allI impI)
fix k'
assume e1: "yi k' = yi k"
have "k < k' ⟶ k' ≤ t"
proof
assume "k < k'"
then obtain i where f1: "l i ≤ k ∧ k' ≤ l (i+2)" using e1 d2 by metis
moreover have "∀y. l y ≤ k ⟶ y < Suc k" using d3 less_Suc_eq_le order_trans by blast
ultimately have "i ≤ i0" using d4 Greatest_le_nat[of "λ j. l j ≤ k" i "Suc k"] by force
then have "l (i+2) ≤ l(i0+2)" using b19 by (metis Suc_less_eq add_2_eq_Suc' not_le)
then show "k' ≤ t" using f1 d5 by fastforce
qed
then show "k' ≤ t" using d5 by fastforce
qed
ultimately show ?thesis using d4 d5 b27 by fastforce
next
assume "¬ (∃ k' > k. yi k' = yi k)"
then have "∀ k'. yi k' = yi k ⟶ k' ≤ k" using leI by blast
then show ?thesis using b27 by fastforce
qed
qed
obtain q where b29: "q = (λ k. GREATEST k'. yi k = yi k')" by blast
have b30: "⋀ k. yi k = yi (q k)"
proof -
fix k
show "yi k = yi (q k)" using b28[of k] b29 GreatestI_nat[of "λ k'. yi k = yi k'" k "Suc (w k)" ] by force
qed
have b31: "⋀ k k'. yi k' = yi (q k) ⟶ k' ≤ q k"
proof
fix k k'
assume "yi k' = yi (q k)"
then show "k' ≤ q k" using b28[of k] b29 b30 Greatest_le_nat[of "λ k'. yi k = yi k'" k' "Suc (w k)"] by force
qed
obtain p where b32: "p = rec_nat (q 0) (λ n y. q (Suc y))" by blast
obtain r1 where b33: "r1 = { (x,y). ∃ i. x = yi (p i) ∧ y = yi (Suc (p i)) }" by blast
have b34: "⋀ i. p i = q (p i)"
proof -
fix i
show "p i = q (p i)"
proof (induct i)
show "p 0 = q (p 0)" using b29 b30 b32 by simp
next
fix i
assume "p i = q (p i)"
then show "p (Suc i) = q (p (Suc i))" using b29 b30 b32 by simp
qed
qed
have b35: "⋀ i j. i≤j ⟶ p i + (j-i) ≤ p j"
proof -
fix i j
have "⋀ k. q k = k ⟶ q k < q (Suc k)" using b30 b31 by (metis less_eq_Suc_le)
then have "∀ i. p i < p (Suc i)" using b32 b34 by simp
then show "i≤j ⟶ p i + (j-i) ≤ p j" using lem_incrfun_nat[of p] by blast
qed
have b36: "∀ i j. p i = p j ⟶ i = j"
proof (intro allI impI)
fix i j
assume "p i = p j"
then have "i≤j ⟶ i = j" and "j≤i ⟶ j = i" using b35 by fastforce+
then show "i = j" by fastforce
qed
have b37: "∀ i j. yi (p i) = yi (p j) ⟶ i = j" using b29 b34 b36 by metis
have b38: "∀ x ∈ Field r1. ∃ i. x = yi (p i)"
proof
fix x
assume "x ∈ Field r1"
moreover have "∀ i. yi (Suc (p i)) = yi (p (Suc i))" using b30 b32 by simp
ultimately show "∃ i. x = yi (p i)" using b33 unfolding Field_def by force
qed
have b39: "⋀ i. (yi (p i), yi (p (Suc i))) ∈ r1" using b30 b32 b33 by fastforce
have b40: "∀ j. ∀ i. i ≤ j ⟶ (yi (p i), yi (p j)) ∈ r1^*"
proof
fix j0
show "∀ i. i ≤ j0 ⟶ (yi (p i), yi (p j0)) ∈ r1^*"
proof (induct j0)
show "∀i≤0. (yi (p i), yi (p 0)) ∈ r1^*" by blast
next
fix j
assume d1: "∀i≤j. (yi (p i), yi (p j)) ∈ r1^*"
show "∀i≤Suc j. (yi (p i), yi (p (Suc j))) ∈ r1^*"
proof (intro allI impI)
fix i
assume e1: "i≤Suc j"
show "(yi (p i), yi (p (Suc j))) ∈ r1^*"
proof (cases "i = Suc j")
assume "i = Suc j"
then show ?thesis by force
next
assume "i ≠ Suc j"
then have "(yi (p i), yi (p j)) ∈ r1^*" using e1 d1 by simp
then show ?thesis using e1 d1 b39[of j] by simp
qed
qed
qed
qed
have "r1 ⊆ r'" using b23 b33 by blast
moreover have "∀ a ∈ Field r'. ∃ b ∈ Field r1. (a, b) ∈ r'^*"
proof
fix a
assume "a ∈ Field r'"
then obtain k where "a = yi k" using b23 unfolding Field_def by blast
moreover have "k ≤ p k" using b35[of 0 k] by fastforce
ultimately have "(a, yi (p k)) ∈ r'^*" using b24 by blast
moreover have "yi (p k) ∈ Field r1" using b33 unfolding Field_def by blast
ultimately show "∃ b ∈ Field r1. (a, b) ∈ r'^*" by blast
qed
moreover have "CCR r1"
proof -
have "∀a∈Field r1. ∀b∈Field r1. ∃c∈Field r1. (a, c) ∈ r1^* ∧ (b, c) ∈ r1^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field r1" and d2: "b ∈ Field r1"
then obtain i j where "a = yi (p i) ∧ b = yi (p j)" using b38 by blast
then have "i ≤ j ⟶ (a,b) ∈ r1^*" and "j ≤ i ⟶ (b,a) ∈ r1^*" using b40 by blast+
then show "∃c∈Field r1. (a, c) ∈ r1^* ∧ (b, c) ∈ r1^*" using d1 d2 by fastforce
qed
then show "CCR r1" unfolding CCR_def by blast
qed
ultimately have b41: "r1 ∈ 𝔘 r'" unfolding 𝔘_def by blast
then have "CCR r'" using lem_rcc_uset_ne_ccr by blast
moreover have "r' ⊆ r" using b18 b23 by blast
moreover have "∀ x ∈ Field r. ∃y ∈ Field r'. (x, y) ∈ r^*"
proof
fix x
assume c1: "x ∈ Field r"
then obtain y where c2: "y ∈ Field s ∧ (x,y) ∈ r^*" using b1 unfolding 𝔘_def by blast
then obtain n where "y = ai n" using b2 by blast
then obtain m where "y ∈ dncl r {m} ∧ m ∈ Ci (Suc n)" using b14[of "Suc n"] by force
then have "(y, m) ∈ r^* ∧ (m, ci (Suc n)) ∈ r^*" using b16 unfolding dncl_def by blast
then have "(x, ci (Suc n)) ∈ r^*" using c2 by force
moreover obtain y' where c2: "y' = yi (l (Suc n))" by blast
ultimately have c3: "(x,y') ∈ r^*" using b20 by metis
have "(y', yi (Suc (l (Suc n)))) ∈ r'" using c2 b23 by blast
then have "y' ∈ Field r'" unfolding Field_def by blast
then show "∃y ∈ Field r'. (x, y) ∈ r^*" using c3 by blast
qed
ultimately have "r' ∈ 𝔘 r" unfolding 𝔘_def by blast
then have "r1 ∈ 𝔘 r" using b41 lem_rcc_uset_tr by blast
moreover have "single_valued r1" using b33 b37 unfolding single_valued_def by blast
moreover have "acyclic r1"
proof -
have c1: "∀ n. ∀ i j. (yi (p i), yi (p j)) ∈ r1^^(Suc n) ⟶ i < j"
proof
fix n0
show "∀ i j. (yi (p i), yi (p j)) ∈ r1^^(Suc n0) ⟶ i < j"
proof (induct n0)
show "∀i j. (yi (p i), yi (p j)) ∈ r1 ^^ (Suc 0) ⟶ i < j"
proof (intro allI impI)
fix i j
assume "(yi (p i), yi (p j)) ∈ r1^^(Suc 0)"
then obtain i' j'::nat where "yi (p i) = yi (p i') ∧ yi (p j) = yi (Suc (p i'))" using b33 by force
then have "i = i' ∧ j = Suc i'" using b30 b32 b37 by simp
then show "i < j" by blast
qed
next
fix n
assume d1: "∀i j. (yi (p i), yi (p j)) ∈ r1 ^^ (Suc n) ⟶ i < j"
show "∀i j. (yi (p i), yi (p j)) ∈ r1 ^^ Suc (Suc n) ⟶ i < j"
proof (intro allI impI)
fix i j
assume "(yi (p i), yi (p j)) ∈ r1 ^^ Suc (Suc n)"
then obtain x where "(yi (p i), x) ∈ r1 ^^ (Suc n) ∧ (x, yi (p j)) ∈ r1" by force
moreover then obtain k where "x = yi (p k)" using b38 unfolding Field_def by blast
ultimately have e1: "i < k ∧ (yi (p k), yi (p j)) ∈ r1" using d1 by blast
then obtain i' j'::nat where "yi (p k) = yi (p i') ∧ yi (p j) = yi (Suc (p i'))" using b33 by force
then have "k = i' ∧ j = Suc i'" using b30 b32 b37 by simp
then have "k < j" by blast
then show "i < j" using e1 by simp
qed
qed
qed
have "∀ x. (x,x) ∈ r1^+ ⟶ False"
proof (intro allI impI)
fix x
assume d1: "(x,x) ∈ r1^+"
then have "x ∈ Field r1" by (metis FieldI2 Field_def trancl_domain trancl_range)
then obtain i where "x = yi (p i)" using b38 by blast
moreover obtain m::nat where "m > 0 ∧ (x,x) ∈ r1^^m" using d1 trancl_power by blast
moreover then obtain n where "m = Suc n" using less_imp_Suc_add by blast
ultimately have "n < n" using c1 by blast
then show "False" by blast
qed
then show ?thesis unfolding acyclic_def by blast
qed
moreover have "∀ x ∈ Field r1. r1``{x} ≠ {}"
proof
fix x
assume "x ∈ Field r1"
then obtain i where "x = yi (p i)" using b38 by blast
moreover then obtain y where "y = yi (Suc (p i))" by blast
ultimately have "(x,y) ∈ r1" using b33 by blast
then show "r1``{x} ≠ {}" by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_sv_span_scflew:
fixes r::"'U rel"
assumes "CCR r" and "scf r ≤o ω_ord"
shows "∃ r1. r1 ∈ Span r ∧ CCR r1 ∧ single_valued r1"
proof (cases "∥r∥ =o ω_ord")
assume "∥r∥ =o ω_ord"
then obtain s where "s ∈ 𝔘 r ∧ single_valued s" using lem_sv_uset_rcceqw by blast
then show ?thesis using lem_sv_uset_sv_span by blast
next
assume "¬ (∥r∥ =o ω_ord)"
then have "∥r∥ <o ω_ord" using assms lem_scf_ccr_scf_rcc_eq[of r]
by (metis ordIso_ordLess_trans ordIso_transitive ordLeq_iff_ordLess_or_ordIso)
then have b1: "Conelike r" using assms lem_Rcc_eq2_31 by blast
have "∃ s. s ∈ 𝔘 r ∧ single_valued s"
proof (cases "r = {}")
assume "r = {}"
then have "{} ∈ 𝔘 r" unfolding 𝔘_def CCR_def Field_def by blast
moreover have "single_valued {}" unfolding single_valued_def by blast
ultimately show ?thesis by blast
next
assume "r ≠ {}"
then obtain m where c1: "m ∈ Field r ∧ (∀ a ∈ Field r. (a, m) ∈ r^*)" using b1 unfolding Conelike_def by blast
then obtain u v where c2: "(u, v) ∈ r ∧ (u = m ∨ v = m)" unfolding Field_def by blast
obtain s where c3: "s = {(u,v)}" by blast
have "s ⊆ r" using c2 c3 by blast
moreover have "CCR s" using c3 unfolding CCR_def by fastforce
moreover have "∀a∈Field r. ∃b∈Field s. (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
moreover have "m ∈ Field s" using c2 c3 unfolding Field_def by fastforce
ultimately show "∃b∈Field s. (a, b) ∈ r^*" using c1 by blast
qed
ultimately have "s ∈ 𝔘 r" unfolding 𝔘_def by blast
moreover have "single_valued s" using c3 unfolding single_valued_def by blast
ultimately show ?thesis by blast
qed
then show ?thesis using lem_sv_uset_sv_span by blast
qed
lemma lem_sv_span_scfeqw:
fixes r::"'U rel"
assumes "CCR r" and "scf r =o ω_ord"
shows "∃ r1. r1 ∈ Span r ∧ r1 ≠ {} ∧ CCR r1 ∧ single_valued r1 ∧ acyclic r1 ∧ (∀x∈Field r1. r1``{x} ≠ {})"
proof -
have b1: "∥r∥ =o ω_ord" using assms lem_scf_ccr_scf_rcc_eq[of r] by (metis ordIso_transitive)
then obtain s where "s ∈ 𝔘 r ∧ single_valued s ∧ acyclic s ∧ (∀x∈Field s. s``{x} ≠ {})"
using lem_sv_uset_rcceqw by blast
then obtain r1 where b2: "r1 ∈ Span r ∧ CCR r1 ∧ single_valued r1 ∧ s ⊆ r1 ∧ acyclic r1"
using lem_sv_uset_sv_span[of s r] by blast
moreover have "r1 = {} ⟶ False"
proof
assume "r1 = {}"
then have "r = {}" using b2 unfolding Span_def Field_def by force
then show "False" using b1 lem_Rcc_inf_lim lem_rcc_emp lem_rcc_inf by (metis not_ordLess_ordIso)
qed
moreover have "∀x∈Field r1. r1``{x} = {} ⟶ False"
proof (intro ballI impI)
fix x
assume c1: "x ∈ Field r1" and c2: "r1``{x} = {}"
have "∀a∈Field r1. (a, x) ∈ r1^*"
proof
fix a
assume "a ∈ Field r1"
then obtain t where "(x,t) ∈ r1^* ∧ (a,t) ∈ r1^*" using c1 b2 unfolding CCR_def by blast
moreover then have "x = t" using c2 by (metis Image_singleton_iff converse_rtranclE empty_iff)
ultimately show "(a,x) ∈ r1^*" by blast
qed
then have "Conelike r1" using c1 unfolding Conelike_def by blast
moreover have "r1 ∈ 𝔘 r" using b2 unfolding 𝔘_def Span_def by blast
ultimately have "Conelike r" using lem_uset_cl_ext[of r1 r] by blast
then show "False" using b1 lem_Rcc_eq2_12[of r] lem_Rcc_eq2_23[of r] by (metis not_ordLess_ordIso)
qed
ultimately show ?thesis by blast
qed
lemma lem_Ldo_den_ccr_uset:
fixes r s::"'U rel"
assumes "CCR s" and "s ⊆ r ∧ Field s ∈ Den r"
shows "s ∈ 𝔘 r"
using assms unfolding Den_def 𝔘_def by blast
lemma lem_Ldo_ds_reduc:
fixes r s::"'U rel" and n0::nat
assumes a1: "CCR s ∧ DCR n0 s" and a2: "s ⊆ r" and a3: "Field s ∈ Den r" and a4: "Field s ∈ Inv (r - s)"
shows "CCR r ∧ DCR (Suc n0) r"
proof -
obtain g0 where b1: "DCR_generating g0"
and b2: "s = ⋃ {r'. ∃α'. α' < n0 ∧ r' = g0 α'}"
using a1 unfolding DCR_def by blast
obtain g :: "nat ⇒ 'U rel"
where b8: "g = (λ α. if (α < n0) then (g0 α) else (r- s))" by blast
obtain n :: nat where b9: "n = (Suc n0)" by blast
have b11: "⋀ α. α < n0 ⟹ g α = (g0 α)" using b8 by simp
have b12: "⋀ α. ¬ (α < n0) ⟹ g α = (r- s)" using b8 by force
have "∀α β a b c.
α ≤ β ⟶ (a, b) ∈ g α ∧ (a, c) ∈ g β ⟶
(∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α)"
proof (intro allI impI)
fix α β a b c
assume c0: "α ≤ β" and c1: "(a, b) ∈ g α ∧ (a, c) ∈ g β"
have "α < n0 ∧ β < n0
⟶ (∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α)"
proof
assume d1: "α < n0 ∧ β < n0"
moreover then have "(a, b) ∈ g0 α ∧ (a, c) ∈ g0 β" using c1 b11 by blast
then obtain b' b'' c' c'' d where d2: "(b, b', b'', d) ∈ 𝔇 g0 α β ∧ (c, c', c'', d) ∈ 𝔇 g0 β α"
using b1 unfolding DCR_generating_def by blast
have "(b, b', b'', d) ∈ 𝔇 g α β"
proof -
have "(b, b') ∈ (𝔏1 g α)^*"
proof -
have "∀ α'. α' < α ⟶ g α' = g0 α'" using d1 b11 by force
then have "𝔏1 g α = 𝔏1 g0 α" unfolding 𝔏1_def by blast
moreover have "(b,b') ∈ (𝔏1 g0 α)^*" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
moreover have "(b', b'') ∈ (g β)^="
proof -
have "g β = g0 β" using d1 b11 by blast
moreover have "(b',b'') ∈ (g0 β)^=" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
moreover have "(b'', d) ∈ (𝔏v g α β)^*"
proof -
have "∀ α'. α' < α ∨ α' < β ⟶ g α' = g0 α'" using d1 b11 by force
then have "𝔏v g α β = 𝔏v g0 α β" unfolding 𝔏v_def by blast
moreover have "(b'',d) ∈ (𝔏v g0 α β)^*" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
ultimately show ?thesis unfolding 𝔇_def by blast
qed
moreover have "(c, c', c'', d) ∈ 𝔇 g β α"
proof -
have "(c, c') ∈ (𝔏1 g β)^*"
proof -
have "∀ α'. α' < β ⟶ g α' = g0 α'" using d1 b11 by force
then have "𝔏1 g β = 𝔏1 g0 β" unfolding 𝔏1_def by blast
moreover have "(c,c') ∈ (𝔏1 g0 β)^*" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
moreover have "(c', c'') ∈ (g α)^="
proof -
have "g α = g0 α" using d1 b11 by blast
moreover have "(c',c'') ∈ (g0 α)^=" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
moreover have "(c'', d) ∈ (𝔏v g β α)^*"
proof -
have "∀ α'. α' < α ∨ α' < β ⟶ g α' = g0 α'" using d1 b11 by force
then have "𝔏v g β α = 𝔏v g0 β α" unfolding 𝔏v_def by blast
moreover have "(c'',d) ∈ (𝔏v g0 β α)^*" using d2 unfolding 𝔇_def by blast
ultimately show ?thesis by metis
qed
ultimately show ?thesis unfolding 𝔇_def by blast
qed
ultimately show "∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α" by blast
qed
moreover have "α < n0 ∧ ¬ (β < n0)
⟶ (∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α)"
proof
assume d1: "α < n0 ∧ ¬ (β < n0)"
then have d2: "(a, b) ∈ g0 α ∧ (g β) = (r - s)" using c1 b11 b12 by blast
have d3: "(a,b) ∈ s ∧ (a,c) ∈ r - s" using d1 d2 c1 b2 unfolding Field_def by blast
then have "b ∈ Field s ∧ c ∈ Field s" using a4 unfolding Field_def Inv_def by blast
then obtain d where d6: "d ∈ Field s ∧ (b,d) ∈ s^* ∧ (c,d) ∈ s^*"
using a1 unfolding CCR_def by blast
have "∀ α'. α' < n0 ⟶ α' < β" using d1 by force
then have "s ⊆ 𝔏v g α β ∧ s ⊆ 𝔏v g β α" using b2 b11 unfolding 𝔏v_def by blast
then have "(b,d) ∈ (𝔏v g α β)^* ∧ (c,d) ∈ (𝔏v g β α)^*" using d6 rtrancl_mono by blast
then show "∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α"
unfolding 𝔇_def by blast
qed
moreover have "¬ (α < n0) ∧ (β < n0) ⟶ False" using c0 by force
moreover have "¬ (α < n0) ∧ ¬ (β < n0)
⟶ (∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α)"
proof
assume d1: "¬ (α < n0) ∧ ¬ (β < n0)"
then have d2: "(g α) = (r - s) ∧ (g β) = (r - s)" using b12 by blast
then have d3: "b ∈ Field r ∧ c ∈ Field r" using c1 unfolding Field_def by blast
obtain b'' where d4: "b'' ∈ Field s ∧ (b,b'') ∈ r^= ∧ ((b,b'') ∈ s ⟶ b = b'')"
using a3 d3 unfolding Den_def
by (cases "∃ b''. (b,b'') ∈ s", metis Domain.DomainI Field_def UnCI pair_in_Id_conv, blast)
obtain c'' where d5: "c'' ∈ Field s ∧ (c,c'') ∈ r^= ∧ ((c,c'') ∈ s ⟶ c = c'')"
using a3 d3 unfolding Den_def
by (cases "∃ c''. (c,c'') ∈ s", metis Domain.DomainI Field_def UnCI pair_in_Id_conv, blast)
obtain d where d6: "d ∈ Field s ∧ (b'',d) ∈ s^* ∧ (c'',d) ∈ s^*"
using d4 d5 a1 unfolding CCR_def by blast
have "∀ α'. α' < n0 ⟶ α' < α" using d1 by force
then have "s ⊆ 𝔏v g α β ∧ s ⊆ 𝔏v g β α" using b2 b11 unfolding 𝔏v_def by blast
then have "(b'',d) ∈ (𝔏v g α β)^* ∧ (c'',d) ∈ (𝔏v g β α)^*" using d6 rtrancl_mono by blast
moreover have "(b,b'') ∈ (g β)^=" using d2 d4 by blast
moreover have "(c,c'') ∈ (g α)^=" using d2 d5 by blast
ultimately show "∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α"
unfolding 𝔇_def by blast
qed
ultimately show "∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 g α β ∧ (c, c', c'', d) ∈ 𝔇 g β α" by blast
qed
then have "DCR_generating g" using lem_Ldo_ldogen_ord by blast
moreover have "r = ⋃ {r'. ∃α'. α' < n ∧ r' = g α'}"
proof -
have "r ⊆ ⋃ {r'. ∃α'. α' < n ∧ r' = g α'}"
proof
fix p
assume c1: "p ∈ r"
have "∃ α'. α' < n ∧ p ∈ g α'"
proof (cases "p ∈ s")
assume "p ∈ s"
then obtain α' where "α' < n0 ∧ p ∈ g α'" using b2 b11 by blast
moreover then have "α' < n" using b9 by force
ultimately show "∃ α'. α' < n ∧ p ∈ g α'" by blast
next
assume "p ∉ s"
moreover have "¬ ( n < n0)" using b9 by simp
ultimately have "p ∈ g n0" using c1 b12 by blast
then show "∃ α'. α' < n ∧ p ∈ g α'" using b9 by blast
qed
then show "p ∈ ⋃ {r'. ∃α'. α' < n ∧ r' = g α'}" by blast
qed
moreover have "∀ α'. g α' ⊆ r"
proof
fix α'
have "α' < n0 ⟶ g0 α' ⊆ r" using a2 b2 by blast
then show "g α' ⊆ r" using b8 by (cases "α' < n0", force+)
qed
ultimately show ?thesis by force
qed
moreover have "CCR r" using a1 a2 a3 lem_Ldo_den_ccr_uset lem_rcc_uset_ne_ccr by blast
ultimately show ?thesis unfolding b9 DCR_def by blast
qed
lemma lem_Ldo_sat_reduc:
fixes r s::"'U rel" and n::nat
assumes a1: "s ∈ Span r" and a2: "CCR s ∧ DCR n s"
shows "CCR r ∧ DCR (Suc n) r"
proof -
have "Field s ∈ Inv (r - s)" using a1 unfolding Span_def Inv_def Field_def by blast
moreover have "s ⊆ r" and "Field s ∈ Den r" using a1 unfolding Span_def Den_def by blast+
ultimately show ?thesis using a2 lem_Ldo_ds_reduc by blast
qed
lemma lem_Ldo_uset_reduc:
fixes r s::"'U rel" and n0::nat
assumes a1: "s ∈ 𝔘 r" and a2: "DCR n0 s" and a3: "n0 ≠ 0"
shows "DCR (Suc n0) r"
proof -
have b0: "s ⊆ r" using a1 unfolding 𝔘_def by blast
obtain g0 where b1: "DCR_generating g0"
and b2: "s = ⋃ {r'. ∃α'. α' < n0 ∧ r' = g0 α'}"
using a2 unfolding DCR_def by blast
obtain isd where b3: "isd = (λ a i. ∃ b ∈ Field s. (a, b) ∈ r^^i ∧ (∀ i'. (∃ b ∈ Field s. (a, b) ∈ r^^(i')) ⟶ i ≤ i'))" by blast
obtain d where b4: "d = (λ a. SOME i. isd a i)" by blast
obtain B where b5: "B = (λ a. { a'. (a, a') ∈ r })" by blast
obtain H where b6: "H = (λ a. { a' ∈ B a. ∀ a'' ∈ B a. (d a') ≤ (d a'') })" by blast
obtain D where b7: "D = { a ∈ Field r - Field s. H a ≠ {}}" by blast
obtain h where "h = (λ a. SOME a'. a' ∈ H a)" by blast
then have b8: "∀ a ∈ D. h a ∈ H a" using b7 someI_ex[of "λ a'. a' ∈ H _"] by force
have q1: "⋀ a. a ∈ Field r ⟹ isd a (d a)"
proof -
fix a
assume c1: "a ∈ Field r"
then obtain b where c2: "b ∈ Field s ∧ (a,b) ∈ r^*" using a1 unfolding 𝔘_def by blast
moreover obtain N where c3: "N = {i. ∃ b ∈ Field s. (a, b) ∈ r^^i}" by blast
ultimately have "N ≠ {}" using rtrancl_imp_relpow by blast
then obtain m where "m ∈ N ∧ (∀ i ∈ N. m ≤ i)"
using LeastI[of "λ x. x ∈ N"] Least_le[of "λ x. x ∈ N"] by blast
then have "isd a m" using c2 c3 unfolding b3 by blast
then show "isd a (d a)" using b4 someI_ex by metis
qed
have q2: "⋀ a. B a ≠ {} ⟹ H a ≠ {}"
proof -
fix a
assume "B a ≠ {}"
moreover obtain N where c1: "N = d ` (B a)" by blast
ultimately have "N ≠ {}" by blast
then obtain m where c2: "m ∈ N ∧ (∀ i ∈ N. m ≤ i)"
using LeastI[of "λ x. x ∈ N"] Least_le[of "λ x. x ∈ N"] by blast
then obtain a' where c3: "m = d a' ∧ a' ∈ B a" using c1 by blast
moreover then have "∀ a'' ∈ B a. d a' ≤ d a''" using c1 c2 by force
ultimately have "a' ∈ H a" unfolding b6 by blast
then show "H a ≠ {}" by blast
qed
have q3: "∀ a ∈ Field r - Field s. d a = 1 ∨ d a > 1"
proof
fix a
assume c1: "a ∈ Field r - Field s"
then have "isd a (d a)" using q1 by blast
then obtain b where "b ∈ Field s ∧ (a, b) ∈ r^^(d a)" using b3 by blast
then have "d a = 0 ⟶ False" using c1 by force
then show "d a = 1 ∨ d a > 1" by force
qed
have "Field r - Field s ⊆ D"
proof
fix a
assume c1: "a ∈ Field r - Field s"
moreover have "H a = {} ⟶ False"
proof
assume "H a = {}"
then have "B a = {}" using q2 by blast
moreover obtain b where "b ∈ Field s ∧ (a, b) ∈ r^*" using a1 c1 unfolding 𝔘_def by blast
ultimately have "a ∈ Field s" unfolding b5 by (metis Collect_empty_eq converse_rtranclE)
then show "False" using c1 by blast
qed
ultimately show "a ∈ D" using b7 by blast
qed
then have q4: "D = Field r - Field s" using b5 b6 b7 by blast
have q5: "∀ a ∈ D. d a > 1 ⟶ d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)"
proof (intro ballI impI)
fix a
assume c1: "a ∈ D" and c2: "d a > 1"
then obtain b where c3: "b ∈ Field s" and c4: "(a, b) ∈ r^^(d a)"
and c5: "∀ i'. (∃ b ∈ Field s. (a, b) ∈ r^^(i')) ⟶ (d a) ≤ i'"
using b3 b7 q1 by blast
have c6: "d a ≥ 1" using c1 c4 b7 q3 by force
then have "d a = Suc ((d a) - 1)" by simp
then obtain a' where c7: "(a,a') ∈ r ∧ (a',b) ∈ r^^((d a) - 1)"
using c4 relpow_Suc_D2[of a b "d a - 1" r] by metis
moreover then have "a' ∉ Field s" using c2 c5 by (metis less_Suc_eq_le not_less_eq relpow_1)
ultimately have "(a,a') ∈ r ∧ a' ∈ Field r - Field s" unfolding Field_def by blast
then have "a' ∈ B a" unfolding b5 by blast
moreover have "h a ∈ H a" using c1 b8 by blast
ultimately have "d (h a) ≤ d a'" unfolding b6 by blast
moreover have "Suc (d a') ≤ d a"
proof -
have "d a' ≤ d a - 1" using q1 b3 c7 c3 unfolding Field_def by blast
then show ?thesis using c6 by force
qed
moreover have "d a ≤ (Suc (d (h a)))"
proof -
have d1: "(a, h a) ∈ r" using c1 b5 b6 b8 by blast
then have "h a ∈ Field r" unfolding Field_def by blast
then obtain b' where "b' ∈ Field s ∧ ((h a), b') ∈ r^^(d (h a))" using b3 q1 by blast
moreover then have "(a,b') ∈ r^^(Suc (d (h a)))" using d1 c7 by (meson relpow_Suc_I2)
ultimately show "d a ≤ (Suc (d (h a)))" using c5 by blast
qed
ultimately have "d a = Suc (d (h a))" by force
moreover have "d (h a) > 1 ⟶ h a ∈ D"
proof
assume d1: "d (h a) > 1"
then have d2: "(a, h a) ∈ r" using c1 b5 b6 b8 by simp
then have "isd (h a) (d (h a))" using d1 q1 unfolding Field_def by force
then have "(h a) ∉ Field s" using d1 b3 by force
then show "h a ∈ D" using d2 q4 unfolding Field_def by blast
qed
ultimately show "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" by blast
qed
obtain g1 where b9: "g1 = { (a, b). a ∈ D ∧ b = h a }" by blast
have q6: "∀ a ∈ D. ∃ a' ∈ D. d a' = 1 ∧ (a,a') ∈ g1^*"
proof -
have "∀ n. ∀ a ∈ D. d a = Suc n ⟶ ((h^^n) a) ∈ D ∧ d ((h^^n) a) = 1"
proof
fix n0
show "∀ a ∈ D. d a = Suc n0 ⟶ ((h^^n0) a) ∈ D ∧ d ((h^^n0) a) = 1"
proof (induct n0)
show "∀a∈D. d a = Suc 0 ⟶ ((h^^0) a) ∈ D ∧ d ((h ^^ 0) a) = 1"
using q4 by force
next
fix n
assume d1: "∀a∈D. d a = Suc n ⟶ ((h^^n) a) ∈ D ∧ d ((h ^^ n) a) = 1"
show "∀a∈D. d a = Suc (Suc n) ⟶ ((h^^(Suc n)) a) ∈ D ∧ d ((h ^^ Suc n) a) = 1"
proof (intro ballI impI)
fix a
assume e1: "a ∈ D" and e2: "d a = Suc (Suc n)"
then have "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" using q5 by simp
moreover then have e3: "d (h a) = Suc n" using e2 by simp
ultimately have "d (h a) > 1 ⟶ ((h^^n) (h a)) ∈ D ∧ d ((h^^n) (h a)) = 1" using d1 by blast
moreover have "(h^^n) (h a) = (h^^(Suc n)) a" by (metis comp_apply funpow_Suc_right)
moreover have e4: "d (h a) = 1 ⟶ d ((h^^(Suc n)) a) = 1" using e3 by simp
moreover have "d (h a) = 1 ⟶ ((h^^(Suc n)) a) ∈ D"
proof
assume f1: "d (h a) = 1"
then have f2: "n = 0 ∧ (a, h a) ∈ r" using e1 e3 b5 b6 b8 by simp
then have "isd (h a) 1" using f1 q1 unfolding Field_def by force
then have "(h a) ∉ Field s" using b3 by force
then have "(h a) ∈ D" using q4 f2 unfolding Field_def by blast
then show "((h^^(Suc n)) a) ∈ D" using f2 by simp
qed
moreover have "d (h a) = 1 ∨ d (h a) > 1" using e3 by force
ultimately show "((h^^(Suc n)) a) ∈ D ∧ d ((h ^^ (Suc n)) a) = 1" by force
qed
qed
qed
moreover have "∀ i. ∀ a ∈ D. d a > i ⟶ (a, (h^^i) a) ∈ g1^*"
proof
fix i0
show "∀ a ∈ D. d a > i0 ⟶ (a, (h^^i0) a) ∈ g1^*"
proof (induct i0)
show "∀a∈D. d a > 0 ⟶ (a, (h^^0) a) ∈ g1^*" by force
next
fix i
assume d1: "∀a∈D. d a > i ⟶ (a, (h^^i) a) ∈ g1^*"
show "∀a∈D. d a > (Suc i) ⟶ (a, (h^^(Suc i)) a) ∈ g1^*"
proof (intro ballI impI)
fix a
assume e1: "a ∈ D" and e2: "d a > (Suc i)"
then have e3: "d a = Suc (d (h a)) ∧ (d (h a) > 1 ⟶ h a ∈ D)" using q5 by simp
moreover then have e4: "d (h a) > i" using e2 by simp
ultimately have "d (h a) > 1 ⟶ (h a, (h^^i) (h a)) ∈ g1^*" using d1 by simp
moreover have "(h^^i) (h a) = (h^^(Suc i)) a" by (metis comp_apply funpow_Suc_right)
moreover have "d (h a) = 1 ⟶ (h^^(Suc i)) a = (h a)" using e4 by force
moreover have "d (h a) = 1 ∨ d (h a) > 1" using e4 by force
moreover then have "(a, h a) ∈ g1" using e1 e3 unfolding b9 by simp
ultimately show "(a, (h^^(Suc i)) a) ∈ g1^*"
by (metis converse_rtrancl_into_rtrancl r_into_rtrancl)
qed
qed
qed
ultimately have "∀n. ∀a∈D. d a = Suc n ⟶ (h^^n) a ∈ D ∧ d ((h^^n) a) = 1 ∧ (a, (h ^^ n) a) ∈ g1^*"
by simp
then have "∀n. ∀a∈D. d a = Suc n ⟶ (∃ a' ∈ D. d a' = 1 ∧ (a,a') ∈ g1^* )"
by blast
moreover have "∀ a ∈ D. ∃ n. d a = Suc n" using q3 q4 q5 by force
ultimately show ?thesis by blast
qed
let ?cond1 = "λ α. α = 0"
let ?cond3 = "λ α. (1 ≤ α ∧ α < n0)"
obtain g :: "nat ⇒ 'U rel"
where b12: "g = (λ α. if (?cond1 α) then (g0 α) ∪ g1
else (if (?cond3 α) then (g0 α)
else {} ))" by blast
obtain n :: nat where b13: "n = n0" by blast
then have b14: "⋀ α. α < n ⟹ (?cond1 α ∨ ?cond3 α)" by force
have b15: "⋀ α. ?cond1 α ⟹ g α = (g0 α) ∪ g1" using b12 by simp
have b17: "⋀ α. ?cond3 α ⟹ g α = (g0 α)" using b12 by force
obtain r1 where b19: "r1 = ⋃ {r'. ∃α'. α' < n ∧ r' = g α'}" by blast
have t1: "g1 ⊆ r1" using b15 b19 b13 a3 by blast
have b20: "s ⊆ r1"
proof
fix p
assume "p ∈ s"
then obtain α' where c1: "α' < n0 ∧ p ∈ g0 α'" using b2 by blast
then have c2: "α' < n" unfolding b13 by fastforce
then have "?cond1 α' ∨ ?cond3 α'" using b14 by blast
then have "g0 α' ⊆ g α'" using b12 by fastforce
then show "p ∈ r1" using c1 c2 b19 by blast
qed
have b21: "r1 ⊆ r"
proof -
have "∀ r' α'. α' < n ⟶ g α' ⊆ r"
proof (intro allI impI)
fix r' α'
assume d1: "α' < n"
have "∀ a ∈ D. (a, h a) ∈ r" using b5 b6 b8 by blast
then have d2: "g1 ⊆ r" using b9 by blast
have "(α' = 0) ⟶ g α' ⊆ r" using d2 b0 b2 b15[of α'] a3 by blast
moreover have "1 ≤ α' ⟶ g α' ⊆ r" using b17 b0 b2 b13 d1 by blast
ultimately show "g α' ⊆ r" using d1 b14 by blast
qed
then show "r1 ⊆ r" unfolding b19 by fast
qed
have b22: "∀a ∈ Field r1 - Field s. ∃b ∈ Field s. (a, b) ∈ r1^*"
proof
fix a
assume d1: "a ∈ Field r1 - Field s"
then have "a ∈ D" using q4 b21 unfolding Field_def by blast
then obtain a' where d2: "a' ∈ D ∧ d a' = 1 ∧ (a, a') ∈ g1^*" using q6 by blast
then have d3: "(a', h a') ∈ r1 ∧ h a' ∈ H a'" using q4 b8 b9 t1 a3 by blast
obtain b where "b ∈ Field s ∧ (a',b) ∈ r" using d2 q1 q4 b3 by force
moreover then have "isd b (d b)" using q1 unfolding Field_def by blast
ultimately have "b ∈ B a' ∧ d b = 0" using b3 b5 by force
then have "d (h a') = 0" using d3 b6 by force
then have "isd (h a') 0" using q1 d3 b21 a3 unfolding Field_def by force
then have "h a' ∈ Field s" using b3 by force
moreover have "(a, a') ∈ r1^*" using d2 t1 rtrancl_mono[of g1 r1] a3 by blast
ultimately have "(h a') ∈ Field s ∧ (a, h a') ∈ r1^*" using d3 by force
then show "∃b ∈ Field s. (a, b) ∈ r1^*" by blast
qed
have b23: "Field r ⊆ Field r1"
proof -
have "(Field r - Field s) ⊆ Field r1" using q4 b9 t1 unfolding Field_def by blast
moreover have "Field s ⊆ Field r1" using b20 unfolding Field_def by blast
ultimately show "Field r ⊆ Field r1" by blast
qed
have "∀α β a b c. α ≤ β ⟶ (a,b) ∈ g α ∧ (a,c) ∈ g β ⟶
(∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α)"
proof (intro allI impI)
fix α β a b c
assume c1: "α ≤ β" and c2: "(a,b) ∈ g α ∧ (a,c) ∈ g β"
obtain c123 where c0: "c123 = (λ α::nat. ?cond1 α ∨ ?cond3 α)" by blast
have c3: "⋀ α'. c123 α' ⟹ g0 α' ⊆ s"
proof -
fix α'
assume "c123 α'"
moreover have "?cond1 α' ⟶ g0 α' ⊆ s" using a3 unfolding b2 by force
moreover have "?cond3 α' ⟶ g0 α' ⊆ s" using b2 by force
ultimately show "g0 α' ⊆ s" using c0 by blast
qed
have c4: "⋀α'. ⋀ p. p ∈ g α' ⟶ (?cond1 α' ∧ p ∈ (g0 α' ∪ g1)) ∨ (?cond3 α' ∧ p ∈ (g0 α'))"
proof (intro impI)
fix α' p
assume "p ∈ g α'"
then show "(?cond1 α' ∧ p ∈ (g0 α' ∪ g1)) ∨ (?cond3 α' ∧ p ∈ (g0 α'))"
using b12 by (cases "?cond1 α'", simp, cases "?cond3 α'", force+)
qed
have c5: "⋀ α' β'. α' ≤ β' ⟹ c123 β' ⟹ c123 α'" unfolding c0 using b14 by force
have c6: "(a,b) ∈ g0 α ∧ (a,c) ∉ g0 β ⟶ ¬ c123 β"
proof
assume d1: "(a,b) ∈ g0 α ∧ (a,c) ∉ g0 β"
then have "(a,c) ∈ g1" using c2 c4 by blast
then have "a ∈ Field r - Field s" using b7 b9 by blast
then have "¬ c123 α" using d1 c3 unfolding Field_def by blast
then show "¬ c123 β" using c1 c5 by blast
qed
have c7: "(a,b) ∉ g0 α ∧ (a,c) ∈ g0 β ⟶ ¬ c123 β"
proof
assume d1: "(a,b) ∉ g0 α ∧ (a,c) ∈ g0 β"
then have "(a,b) ∈ g1" using c2 c4 by blast
then have "a ∈ Field r - Field s" using b7 b9 by blast
then show " ¬ c123 β" using d1 c3 unfolding Field_def by blast
qed
have c8: "⋀ α'. c123 α' ⟹ g0 α' ⊆ g α'"
proof -
fix α'
assume "c123 α'"
then show "g0 α' ⊆ g α'" unfolding c0 using b15[of α'] b17[of α'] by blast
qed
then have c9: "⋀ α' α''. c123 α' ⟹ α'' < α' ⟹ g0 α'' ⊆ g α''"
using c5 less_or_eq_imp_le by blast
have c10: "⋀ α' β'. c123 α' ⟹ c123 β' ⟹ 𝔇 g0 α' β' ⊆ 𝔇 g α' β'"
proof -
fix α' β'
assume d1: "c123 α'" and d2: "c123 β'"
have "𝔏1 g0 α' ⊆ 𝔏1 g α'" using d1 c9 unfolding 𝔏1_def by blast
moreover have "𝔏v g0 α' β' ⊆ 𝔏v g α' β'" using d1 d2 c9 unfolding 𝔏v_def by blast
ultimately have "(𝔏1 g0 α')^* ⊆ (𝔏1 g α')^* ∧ (𝔏v g0 α' β')^* ⊆ (𝔏v g α' β')^*"
using rtrancl_mono by blast
moreover have "g0 β' ⊆ g β'" using d2 c8 by blast
ultimately show "𝔇 g0 α' β' ⊆ 𝔇 g α' β'" unfolding 𝔇_def by blast
qed
show "∃b' b'' c' c'' d'. (b,b',b'',d') ∈ 𝔇 g α β ∧ (c,c',c'',d') ∈ 𝔇 g β α"
proof (cases "c123 β")
assume d1: "c123 β"
show ?thesis
proof (cases "(a,b) ∈ g0 α ∧ (a,c) ∈ g0 β")
assume e1: "(a,b) ∈ g0 α ∧ (a,c) ∈ g0 β"
then obtain b' b'' c' c'' d' where "(b, b', b'', d') ∈ 𝔇 g0 α β ∧ (c, c', c'', d') ∈ 𝔇 g0 β α"
using b1 unfolding DCR_generating_def by blast
moreover have "c123 α" using d1 c1 c5 by blast
ultimately have "(b, b', b'', d') ∈ 𝔇 g α β ∧ (c, c', c'', d') ∈ 𝔇 g β α" using d1 c10 by blast
then show ?thesis by blast
next
assume "¬ ((a,b) ∈ g0 α ∧ (a,c) ∈ g0 β)"
then have "(a,b) ∉ g0 α ∧ (a,c) ∉ g0 β" using d1 c6 c7 by blast
moreover have "c123 α" using d1 c1 c5 by blast
ultimately have "(a,b) ∈ g1 ∧ (a,c) ∈ g1" using d1 c0 c2 c4 by blast
then have "b = c" using b9 by blast
then show ?thesis unfolding 𝔇_def by blast
qed
next
assume d1: "¬ c123 β"
then have d2: "False" using c2 c4 unfolding c0 by blast
then show ?thesis by blast
qed
qed
then have b24: "DCR_generating g" using a3 lem_Ldo_ldogen_ord by blast
moreover then have "Field r1 ⊆ Field r" using b21 unfolding Field_def by blast
ultimately have "r1 ∈ Span r" using b21 b23 unfolding Span_def by blast
moreover have "DCR n r1" using b19 b24 unfolding DCR_def by blast
moreover have "CCR r1"
proof -
have "s ∈ 𝔘 r1" using b20 b22 a1 unfolding 𝔘_def by blast
then show "CCR r1" using lem_rcc_uset_ne_ccr by blast
qed
ultimately show "DCR (Suc n0) r" using b13 a3 lem_Ldo_sat_reduc by blast
qed
lemma lem_Ldo_addid:
fixes r::"'U rel" and r'::"'U rel" and n0::nat and A::"'U set"
assumes a1: "DCR n0 r" and a2: "r' = r ∪ {(a,b). a = b ∧ a ∈ A}" and a3: "n0 ≠ 0"
shows "DCR n0 r'"
proof -
obtain g0 where b1: "DCR_generating g0" and b2: "r = ⋃{r'. ∃α'<n0. r' = g0 α'}" using a1 unfolding DCR_def by blast
obtain g :: "nat ⇒ 'U rel" where b3: "g = (λ α. (g0 α) ∪ {(a,b). a = b ∧ a ∈ A})" by blast
have "∀α β a b c. α ≤ β ⟶ (a,b) ∈ g α ∧ (a,c) ∈ g β ⟶
(∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α)"
proof (intro allI impI)
fix α β a b c
assume c1: "α ≤ β" and c2: "(a,b) ∈ g α ∧ (a,c) ∈ g β"
have c3: "⋀ α' β'. 𝔇 g0 α' β' ⊆ 𝔇 g α' β'"
proof -
fix α' β'
have "𝔏1 g0 α' ⊆ (𝔏1 g α')^=" unfolding 𝔏1_def b3 by (clarsimp, auto)
moreover have "𝔏v g0 α' β' ⊆ (𝔏v g α' β')^=" unfolding 𝔏v_def b3 by (clarsimp, auto)
ultimately have "(𝔏1 g0 α')^* ⊆ (𝔏1 g α')^* ∧ (𝔏v g0 α' β')^* ⊆ (𝔏v g α' β')^*" using rtrancl_reflcl rtrancl_mono by blast
moreover have "(g0 β')^= ⊆ (g β')^=" unfolding b3 by force
ultimately show "𝔇 g0 α' β' ⊆ 𝔇 g α' β'" unfolding 𝔇_def by blast
qed
have c4: "((a,b) ∈ g0 α ∨ a = b) ∧ ((a,c) ∈ g0 β ∨ a = c)" using c1 c2 b3 by blast
moreover then have "a = b ∨ a = c ⟶ (∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α)"
using b3 unfolding 𝔇_def by blast
moreover have "(a,b) ∈ g0 α ∧ (a,c) ∈ g0 β ⟶ (∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α)"
proof
assume "(a,b) ∈ g0 α ∧ (a,c) ∈ g0 β"
then obtain b' b'' c' c'' d' where "(b, b', b'', d') ∈ 𝔇 g0 α β ∧ (c, c', c'', d') ∈ 𝔇 g0 β α"
using b1 unfolding DCR_generating_def by blast
then have "(b, b', b'', d') ∈ 𝔇 g α β ∧ (c, c', c'', d') ∈ 𝔇 g β α" using c3 by blast
then show "∃b' b'' c' c'' d'. (b,b',b'',d') ∈ 𝔇 g α β ∧ (c,c',c'',d') ∈ 𝔇 g β α" by blast
qed
ultimately show "∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α" by blast
qed
then have "DCR_generating g" using lem_Ldo_ldogen_ord by blast
moreover have "r' = ⋃{s. ∃α'<n0. s = g α'}" unfolding b2 b3 a2 using a3 by blast
ultimately show "DCR n0 r'" unfolding DCR_def by blast
qed
lemma lem_Ldo_removeid:
fixes r::"'U rel" and r'::"'U rel" and n0::nat
assumes a1: "DCR n0 r" and a2: "r' = r - {(a,b). a = b}"
shows "DCR n0 r'"
proof -
obtain g0 where b1: "DCR_generating g0" and b2: "r = ⋃{r'. ∃α'<n0. r' = g0 α'}" using a1 unfolding DCR_def by blast
obtain g :: "nat ⇒ 'U rel" where b3: "g = (λ α. (g0 α) - {(a,b). a = b })" by blast
have "∀α β a b c. α ≤ β ⟶ (a,b) ∈ g α ∧ (a,c) ∈ g β ⟶
(∃b' b'' c' c'' d. (b,b',b'',d) ∈ 𝔇 g α β ∧ (c,c',c'',d) ∈ 𝔇 g β α)"
proof (intro allI impI)
fix α β a b c
assume c1: "α ≤ β" and c2: "(a,b) ∈ g α ∧ (a,c) ∈ g β"
have c3: "⋀ α' β'. 𝔇 g0 α' β' ⊆ 𝔇 g α' β'"
proof -
fix α' β'
have "𝔏1 g0 α' ⊆ (𝔏1 g α')^=" unfolding 𝔏1_def b3 by (clarsimp, auto)
moreover have "𝔏v g0 α' β' ⊆ (𝔏v g α' β')^=" unfolding 𝔏v_def b3 by (clarsimp, auto)
ultimately have "(𝔏1 g0 α')^* ⊆ (𝔏1 g α')^* ∧ (𝔏v g0 α' β')^* ⊆ (𝔏v g α' β')^*" using rtrancl_reflcl rtrancl_mono by blast
moreover have "(g0 β')^= ⊆ (g β')^=" unfolding b3 by force
ultimately show "𝔇 g0 α' β' ⊆ 𝔇 g α' β'" unfolding 𝔇_def by blast
qed
have "(a,b) ∈ g0 α ∧ (a,c) ∈ g0 β" using c1 c2 b3 by blast
then obtain b' b'' c' c'' d' where "(b, b', b'', d') ∈ 𝔇 g0 α β ∧ (c, c', c'', d') ∈ 𝔇 g0 β α"
using b1 unfolding DCR_generating_def by blast
then have "(b, b', b'', d') ∈ 𝔇 g α β ∧ (c, c', c'', d') ∈ 𝔇 g β α" using c3 by blast
then show "∃b' b'' c' c'' d'. (b,b',b'',d') ∈ 𝔇 g α β ∧ (c,c',c'',d') ∈ 𝔇 g β α" by blast
qed
then have "DCR_generating g" using lem_Ldo_ldogen_ord by blast
moreover have "r' = ⋃{s. ∃α'<n0. s = g α'}" unfolding b2 b3 a2 by blast
ultimately show "DCR n0 r'" unfolding DCR_def by blast
qed
lemma lem_Ldo_eqid:
fixes r::"'U rel" and r'::"'U rel" and n::nat
assumes a1: "DCR n r" and a2: "r' - {(a,b). a = b} = r - {(a,b). a = b}" and a3: "n ≠ 0"
shows "DCR n r'"
proof -
obtain r'' where b1: "r'' = r' - {(a,b). a = b}" by blast
then have "DCR n r''" using a1 a2 lem_Ldo_removeid by blast
moreover have "r' = r'' ∪ {(a,b). a = b ∧ (a,a) ∈ r'}" using b1 by blast
ultimately show "DCR n r'" using lem_Ldo_addid[of n r'' r' "{a . (a,a) ∈ r'}"] a3 by blast
qed
lemma lem_wdn_range_lb: "A ⊆ w_dncl r A"
unfolding w_dncl_def dncl_def ℱ_def rpth_def by fastforce
lemma lem_wdn_range_ub: "w_dncl r A ⊆ dncl r A" unfolding w_dncl_def by blast
lemma lem_wdn_mon: "A ⊆ A' ⟹ w_dncl r A ⊆ w_dncl r A'" unfolding w_dncl_def dncl_def by blast
lemma lem_wdn_compl:
fixes r::"'U rel" and A::"'U set"
shows "UNIV - w_dncl r A = {a. ∃ b. b ∉ dncl r A ∧ (a,b) ∈ (Restr r (UNIV-A))^*}"
proof
show "UNIV - w_dncl r A ⊆ {a. ∃ b. b ∉ dncl r A ∧ (a,b) ∈ (Restr r (UNIV-A))^*}"
proof
fix x
assume c1: "x ∈ UNIV - w_dncl r A"
show "x ∈ {a. ∃ b. b ∉ dncl r A ∧ (a,b) ∈ (Restr r (UNIV-A))^*}"
proof (cases "x ∈ dncl r A")
assume "x ∈ dncl r A"
then obtain b F where d1: "F ∈ ℱ r x b ∧ b ∉ dncl r A ∧ F ∩ A = {}"
using c1 unfolding w_dncl_def by blast
then obtain f n where "f ∈ rpth r x b n ∧ F = f ` {i. i≤n}" unfolding ℱ_def by blast
moreover then have "∀i≤n. f i ∉ A" using d1 unfolding rpth_def by blast
ultimately have "f ∈ rpth (Restr r (UNIV-A)) x b n" unfolding rpth_def by force
then have "(x,b) ∈ (Restr r (UNIV-A))^*" using lem_ccext_rpth_rtr[of "Restr r (UNIV-A)"] by blast
then show ?thesis using d1 by blast
next
assume "x ∉ dncl r A"
then show ?thesis unfolding w_dncl_def by blast
qed
qed
next
show "{a. ∃ b. b ∉ dncl r A ∧ (a,b) ∈ (Restr r (UNIV-A))^*} ⊆ UNIV - w_dncl r A"
proof
fix x
assume "x ∈ {a. ∃ b. b ∉ dncl r A ∧ (a,b) ∈ (Restr r (UNIV-A))^*}"
then obtain y where c1: "y ∉ dncl r A ∧ (x,y) ∈ (Restr r (UNIV-A))^*" by blast
obtain f n where c2: "f ∈ rpth (Restr r (UNIV-A)) x y n" using c1 lem_ccext_rtr_rpth[of x y] by blast
then have c3: "f ∈ rpth r x y n" unfolding rpth_def by blast
obtain F where c4: "F = f`{i. i≤n}" by blast
have "n = 0 ⟶ f 0 ∉ A" using c1 c3 unfolding rpth_def dncl_def by blast
moreover have "∀ i<n. f i ∉ A ∧ f (Suc i) ∉ A" using c2 unfolding rpth_def by blast
moreover have "∀ i≤n. (n = 0 ∨ (∃ j<n. (j=i ∨ i=Suc j)))"
by (metis le_eq_less_or_eq lessI less_Suc_eq_0_disj)
ultimately have "∀ i≤n. f i ∉ A" by blast
then have "F ∩ A = {}" using c4 by blast
moreover have "F ∈ ℱ r x y" using c3 c4 unfolding ℱ_def by blast
ultimately show "x ∈ UNIV - w_dncl r A" using c1 unfolding w_dncl_def by blast
qed
qed
lemma lem_cowdn_uset:
fixes r::"'U rel" and A A' W::"'U set"
assumes a1: "CCR (Restr r A')" and a2: "escl r A A' ⊆ A'"
and a3: "Q = A' - dncl r A" and a4: "W = A' - w_dncl r A" and a5: "Q ∈ SF r"
shows "Restr r Q ∈ 𝔘 (Restr r W)"
proof -
have "CCR (Restr r Q)" using a1 a3 lem_Inv_ccr_restr_invdiff lem_Inv_dncl_invbk by blast
moreover have "Restr r Q ⊆ Restr r W" using a3 a4 lem_wdn_range_ub[of r] by blast
moreover have "∀a∈Field (Restr r W). ∃b∈Field (Restr r Q). (a, b) ∈ (Restr r W)^*"
proof
fix a
assume "a ∈ Field (Restr r W)"
then have c1: "a ∈ W" unfolding Field_def by blast
show "∃b∈Field (Restr r Q). (a, b) ∈ (Restr r W)^*"
proof (cases "a ∈ Q")
assume "a ∈ Q"
then show ?thesis using a5 unfolding SF_def by blast
next
assume "a ∉ Q"
then obtain b F where d1: "a ∈ A' ∧ F ∈ ℱ r a b ∧ b ∉ dncl r A ∧ F ∩ A = {}"
using c1 a3 a4 unfolding w_dncl_def by blast
then have d2: "dnesc r A a ⊆ escl r A A'" unfolding escl_def by blast
obtain E where d3: "E = dnesc r A a" by blast
have "dnEsc r A a ≠ {}" using d1 unfolding dnEsc_def by blast
then have "E ∈ dnEsc r A a" using d3 lem_dnEsc_ne[of r A] by blast
then obtain b' where d4: "b' ∉ dncl r A ∧ E ∈ ℱ r a b' ∧ E ∩ A = {}"
unfolding dnEsc_def by blast
have d5: "E ⊆ A'" using d2 d3 a2 by blast
have "b' ∈ E" using d4 unfolding ℱ_def rpth_def by blast
then have "b' ∈ Field (Restr r Q)" using d4 d5 a3 a5 unfolding SF_def by blast
moreover have "(a, b') ∈ (Restr r W)^*"
proof -
obtain f n where e1: "f ∈ rpth r a b' n" and e2: "E = f ` {i. i ≤ n}"
using d4 unfolding ℱ_def by blast
have e3: "∀ i≤n. f i ∈ W"
proof (intro allI impI)
fix i
assume f1: "i ≤ n"
obtain g where f2: "g = (λ k. f (k + i))" by blast
have "g 0 = f i" using f2 by simp
moreover have "g (n - i) = b'" using f1 f2 e1 unfolding rpth_def by simp
moreover have "∀k<n-i. (g k, g (Suc k)) ∈ Restr r (UNIV - A)"
proof (intro allI impI)
fix k
assume "k < n-i"
then have "(g k, g (Suc k)) ∈ (Restr r E)" using f2 e1 e2 unfolding rpth_def by simp
then show "(g k, g (Suc k)) ∈ Restr r (UNIV - A)" using d4 by blast
qed
ultimately have "g ∈ rpth (Restr r (UNIV-A)) (f i) b' (n-i)" unfolding rpth_def by blast
then have "(f i, b') ∈ (Restr r (UNIV-A))^*" using lem_ccext_rpth_rtr[of _ "f i" b'] by blast
then have "f i ∉ w_dncl r A" using d4 lem_wdn_compl[of r A] by blast
then show "f i ∈ W" using f1 e2 d5 a4 by blast
qed
have "∀i<n. (f i, f (Suc i)) ∈ Restr r W"
proof (intro allI impI)
fix i
assume "i < n"
moreover then have "f i ∈ W ∧ f (Suc i) ∈ W" using e2 e3 by force
ultimately show "(f i, f (Suc i)) ∈ Restr r W" using e1 unfolding rpth_def by blast
qed
then have "E ∈ ℱ (Restr r W) a b'" using e1 e2 unfolding rpth_def ℱ_def by blast
then show ?thesis using lem_ccext_rtr_Fne[of a b'] by blast
qed
ultimately show ?thesis by blast
qed
qed
ultimately show ?thesis unfolding 𝔘_def by blast
qed
lemma lem_shrel_L_eq:
fixes f::"'U rel ⇒ 'U set" and α::"'U rel" and β::"'U rel"
assumes "α =o β"
shows "𝔏 f α = 𝔏 f β"
proof
show "𝔏 f α ⊆ 𝔏 f β" using assms ordLess_ordIso_trans unfolding 𝔏_def by fastforce
next
have "β =o α" using assms ordIso_symmetric by blast
then show "𝔏 f β ⊆ 𝔏 f α" using ordLess_ordIso_trans unfolding 𝔏_def by fastforce
qed
lemma lem_shrel_dbk_eq:
fixes f::"'U rel ⇒ 'U set" and Ps::"'U set set" and α::"'U rel" and β::"'U rel"
assumes "f ∈ 𝒩 r Ps" and "α =o β" and "α ≤o |Field r|" and "β ≤o |Field r|"
shows "(∇ f α) = (∇ f β)"
proof -
have "α ≤o β ∧ β ≤o α" using assms ordIso_iff_ordLeq by blast
then have "f α = f β" using assms unfolding 𝒩_def 𝒩1_def by blast
moreover have "𝔏 f α = 𝔏 f β" using assms lem_shrel_L_eq by blast
ultimately show ?thesis unfolding Dbk_def by blast
qed
lemma lem_L_emp: "α =o ({}::'U rel) ⟹ 𝔏 f α = {}"
proof -
assume "α =o ({}::'U rel)"
then have "∀ α'. α' <o α ⟶ False" using lem_ord_subemp
by (metis iso_ozero_empty not_ordLess_ordIso ordLess_imp_ordLeq ozero_def)
then show "𝔏 f α = {}" unfolding 𝔏_def by blast
qed
lemma lem_der_qinv1:
fixes r::"'U rel" and α::"'U rel" and x y::'U
assumes a1: "x ∈ 𝒬 r f α" and a2: "(x,y) ∈ r^*" and a3: "y ∈ (f α)"
shows "y ∈ 𝒬 r f α"
proof -
obtain A where b1: "A = (𝔏 f α)" by blast
have "∀ x y. y ∈ dncl r A ⟶ (x,y) ∈ r ⟶ x ∈ dncl r A"
proof (intro allI impI)
fix x y
assume "y ∈ dncl r A" and "(x,y) ∈ r"
moreover then obtain a where "a ∈ A ∧ (y,a) ∈ r^*" unfolding dncl_def by blast
ultimately have "a ∈ A ∧ (x,a) ∈ r^*" by force
then show "x ∈ dncl r A" unfolding dncl_def by blast
qed
then have "(UNIV - dncl r A) ∈ Inv r" unfolding Inv_def by blast
moreover have "x ∈ UNIV - (dncl r A)" using b1 a1 unfolding 𝒬_def by blast
ultimately have "y ∈ UNIV - (dncl r A)" using a2 lem_Inv_restr_rtr2[of "UNIV - dncl r A" r] by blast
then show ?thesis using b1 a3 unfolding 𝒬_def by blast
qed
lemma lem_der_qinv2:
fixes r::"'U rel" and α::"'U rel" and x y::'U
assumes a1: "x ∈ 𝒬 r f α" and a2: "(x,y) ∈ (Restr r (f α))^*" and a3: "y ∈ (f α)"
shows "(x,y) ∈ (Restr r (𝒬 r f α))^*"
proof -
obtain Q where b1: "Q = 𝒬 r f α" by blast
have "∀ a b. a ∈ Q ⟶ (a,b) ∈ Restr r (f α) ⟶ b ∈ Q"
using lem_der_qinv1[of _ r f α _] unfolding b1 by blast
then have "Q ∈ Inv (Restr r (f α))" unfolding Inv_def by blast
moreover have "x ∈ Q" using b1 a1 by blast
ultimately have "(x,y) ∈ (Restr (Restr r (f α)) Q)^*"
using a2 lem_Inv_restr_rtr[of Q "Restr r (f α)"] by blast
moreover have "Restr (Restr r (f α)) Q ⊆ Restr r (𝒬 r f α)" using b1 by blast
ultimately show ?thesis using rtrancl_mono by blast
qed
lemma lem_der_qinv3:
fixes r::"'U rel" and α::"'U rel"
assumes a1: "A ⊆ (f α)" and a2: "∀ x ∈ (f α). ∃ y ∈ A. (x,y) ∈ (Restr r (f α))^*"
shows "∀ x ∈ (𝒬 r f α). ∃ y ∈ (A ∩ (𝒬 r f α)). (x,y) ∈ (Restr r (𝒬 r f α))^*"
proof
fix x
assume b1: "x ∈ (𝒬 r f α)"
then have b2: "x ∈ (f α)" unfolding 𝒬_def by blast
then obtain y where b3: "y ∈ A ∧ (x,y) ∈ (Restr r (f α))^*" using a2 by blast
then have "(x, y) ∈ (Restr r (𝒬 r f α))^*" using a1 b1 lem_der_qinv2[of x r f α y] by blast
moreover then have "y ∈ (𝒬 r f α)" using b1 IntE mem_Sigma_iff rtranclE[of x y] by metis
ultimately show "∃ y ∈ (A ∩ (𝒬 r f α)). (x,y) ∈ (Restr r (𝒬 r f α))^*" using b3 by blast
qed
lemma lem_der_inf_qrestr_ccr1:
fixes r::"'U rel" and Ps::"'U set set" and α::"'U rel"
assumes "f ∈ 𝒩 r Ps" and "α ≤o |Field r|"
shows "CCR (Restr r (𝒬 r f α))"
proof -
have "CCR (Restr r (f α))" using assms unfolding 𝒩_def 𝒩6_def by blast
moreover have "dncl r (𝔏 f α) ∈ Inv (r^-1)" using lem_Inv_dncl_invbk by blast
ultimately show ?thesis unfolding 𝒬_def using lem_Inv_ccr_restr_invdiff by blast
qed
lemma lem_Nfdn_aemp:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "CCR r" and a2: "f ∈ 𝒩 r Ps" and a3: "α <o scf r" and a4: "Field r ⊆ dncl r (f α)"
shows "α = {}"
proof (cases "finite r")
assume "finite r"
then have "scf r <o ω_ord" using lem_scf_relfldcard_bnd lem_fin_fl_rel
by (metis finite_iff_ordLess_natLeq ordLeq_ordLess_trans)
then have "finite (Field (scf r))" using finite_iff_ordLess_natLeq by force
then have "Conelike r" using a1 lem_scf_ccr_finscf_cl by blast
moreover obtain a::'U where "True" by blast
ultimately have "α <o |{a}|" using a1 a3 lem_Rcc_eq2_12 lem_scf_ccr_scf_rcc_eq
by (metis ordIso_iff_ordLeq ordLess_ordLeq_trans)
then have b1: "α =o |{}::'U set|" using lem_co_one_ne_min
by (metis card_of_card_order_on card_of_empty3 card_of_unique insert_not_empty
not_ordLeq_ordLess ordIso_Well_order_simp ordLess_Well_order_simp)
then have "α ≤o |Field r|" using card_of_empty ordIso_ordLeq_trans by blast
then have b2: "f α ∈ SF r" using a2 unfolding 𝒩_def 𝒩5_def by blast
have "¬ (∃ α'::'U rel. α' <o α)" using b1
by (metis BNF_Cardinal_Order_Relation.ordLess_Field card_of_empty5 ordLess_ordIso_trans)
then show "α = {}" using a3 b1 using lem_co_one_ne_min
by (metis card_of_empty card_of_empty3 insert_not_empty
ordIso_ordLeq_trans ordLeq_transitive ordLess_Well_order_simp)
next
assume q0: "¬ finite r"
have b0: "α <o ∥r∥" using a1 a3 lem_scf_ccr_scf_rcc_eq by (metis ordIso_iff_ordLeq ordLess_ordLeq_trans)
obtain A' where b1: "A' = 𝒬 r f α" by blast
have "∥r∥ ≤o |r|" using lem_Rcc_relcard_bnd by blast
moreover have "|Field r| =o |r|" using q0 lem_rel_inf_fld_card by blast
ultimately have "∥r∥ ≤o |Field r|" using ordIso_symmetric ordLeq_ordIso_trans by blast
then have b2: "α ≤o |Field r|" using b0 ordLeq_transitive ordLess_imp_ordLeq by blast
then have b3: "f α ∈ SF r ∧ CCR (Restr r (f α))"
using b1 a2 unfolding 𝒩_def 𝒩5_def 𝒩10_def 𝒩6_def by blast+
have b5: "(A' ∈ SF r ) ∨ (∃y::'U. A' = {y})"
using b1 b3 unfolding 𝒬_def using lem_Inv_ccr_sf_dn_diff[of "f α" r A' "𝔏 f α"] by blast
have "∀a∈Field r. ∃b∈Field (Restr r (f α)). (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then have "a ∈ dncl r (f α)" using a4 by blast
then obtain b::'U where "(a, b) ∈ r^* ∧ b ∈ f α" unfolding dncl_def by blast
moreover have "(f α) ∈ SF r" using b3 by blast
ultimately have "b ∈ Field (Restr r (f α)) ∧ (a, b) ∈ r^*" unfolding SF_def by blast
then show "∃b∈Field (Restr r (f α)). (a, b) ∈ r^*" by blast
qed
moreover have "CCR (Restr r (f α))" using b3 by blast
ultimately have "Restr r (f α) ∈ 𝔘 r" unfolding 𝔘_def by blast
then have d3: "∥r∥ ≤o |Restr r (f α)|" using lem_rcc_uset_mem_bnd by blast
obtain x::'U where d4: "True" by blast
have "ω_ord ≤o α ⟶ False"
proof
assume e1: "ω_ord ≤o α"
then have "|f α| ≤o α" using b2 a2 unfolding 𝒩_def 𝒩7_def by blast
moreover then have "|Restr r (f α)| ≤o α" using e1 lem_restr_ordbnd by blast
ultimately have "∥r∥ ≤o α" using d3 ordLeq_transitive by blast
then show "False" using b0 not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
qed
then have "α <o ω_ord" using b0 natLeq_Well_order not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
then have "|f α| <o ω_ord" using b2 a2 unfolding 𝒩_def 𝒩7_def by blast
then have "finite (f α)" using finite_iff_ordLess_natLeq by blast
then have "finite (Restr r (f α))" by blast
then have "|Restr r (f α)| <o ω_ord" using finite_iff_ordLess_natLeq by blast
then have d5: "∥r∥ <o ω_ord" using d3 ordLeq_ordLess_trans by blast
have "∥r∥ ≤o |{x}|"
proof (cases "CCR r")
assume "CCR r"
then show "∥r∥ ≤o |{x}|" using d5 lem_Rcc_eq2_31[of r] lem_Rcc_eq2_12[of r x] by blast
next
assume "¬ CCR r"
moreover then have "∥r∥ = {}" using lem_rcc_nccr by blast
moreover have "{} ≤o |{x}|" by (metis card_of_Well_order ozero_def ozero_ordLeq)
ultimately show "∥r∥ ≤o |{x}|" by metis
qed
then have "α <o |{x}|" using b0 ordLess_ordLeq_trans by blast
then show "α = {}" by (meson lem_co_one_ne_min not_ordLeq_ordLess ordLess_Well_order_simp)
qed
lemma lem_der_qccr_lscf_sf:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "CCR r" and a2: "f ∈ 𝒩 r Ps" and a3: "α <o scf r"
shows "(𝒬 r f α) ∈ SF r"
proof (cases "finite r")
assume "finite r"
then have "scf r <o ω_ord" using lem_scf_relfldcard_bnd lem_fin_fl_rel
by (metis finite_iff_ordLess_natLeq ordLeq_ordLess_trans)
then have "finite (Field (scf r))" using finite_iff_ordLess_natLeq by force
then have "Conelike r" using a1 lem_scf_ccr_finscf_cl by blast
moreover obtain a::'U where "True" by blast
ultimately have "α <o |{a}|" using a1 a3 lem_Rcc_eq2_12 lem_scf_ccr_scf_rcc_eq
by (metis ordIso_iff_ordLeq ordLess_ordLeq_trans)
then have b1: "α =o |{}::'U set|" using lem_co_one_ne_min
by (metis card_of_card_order_on card_of_empty3 card_of_unique insert_not_empty
not_ordLeq_ordLess ordIso_Well_order_simp ordLess_Well_order_simp)
then have "α ≤o |Field r|" using card_of_empty ordIso_ordLeq_trans by blast
then have b2: "f α ∈ SF r" using a2 unfolding 𝒩_def 𝒩5_def by blast
have "¬ (∃ α'::'U rel. α' <o α)" using b1
by (metis BNF_Cardinal_Order_Relation.ordLess_Field card_of_empty5 ordLess_ordIso_trans)
then have "𝔏 f α = {}" unfolding 𝔏_def by blast
then have "𝒬 r f α = f α" unfolding 𝒬_def dncl_def by blast
then show ?thesis using b2 by metis
next
assume q0: "¬ finite r"
have b0: "α <o ∥r∥" using a1 a3 lem_scf_ccr_scf_rcc_eq by (metis ordIso_iff_ordLeq ordLess_ordLeq_trans)
obtain A' where b1: "A' = 𝒬 r f α" by blast
have "∥r∥ ≤o |r|" using lem_Rcc_relcard_bnd by blast
moreover have "|Field r| =o |r|" using q0 lem_rel_inf_fld_card by blast
ultimately have "∥r∥ ≤o |Field r|" using ordIso_symmetric ordLeq_ordIso_trans by blast
then have b2: "α ≤o |Field r|" using b0 ordLeq_transitive ordLess_imp_ordLeq by blast
then have b3: "f α ∈ SF r ∧ CCR (Restr r (f α))"
and b4: "(∃y::'U. A' = {y}) ⟶ Field r ⊆ dncl r (f α)"
using b1 a2 unfolding 𝒩_def 𝒩5_def 𝒩10_def 𝒩6_def by blast+
have b5: "(A' ∈ SF r ) ∨ (∃y::'U. A' = {y})"
using b1 b3 unfolding 𝒬_def using lem_Inv_ccr_sf_dn_diff[of "f α" r A' "𝔏 f α"] by blast
show "(𝒬 r f α) ∈ SF r"
proof (cases "Field r ⊆ dncl r (f α)")
assume c1: "Field r ⊆ dncl r (f α)"
have "∀a∈Field r. ∃b∈Field (Restr r (f α)). (a, b) ∈ r^*"
proof
fix a
assume "a ∈ Field r"
then have "a ∈ dncl r (f α)" using c1 by blast
then obtain b::'U where "(a, b) ∈ r^* ∧ b ∈ f α" unfolding dncl_def by blast
moreover have "(f α) ∈ SF r" using b3 by blast
ultimately have "b ∈ Field (Restr r (f α)) ∧ (a, b) ∈ r^*" unfolding SF_def by blast
then show "∃b∈Field (Restr r (f α)). (a, b) ∈ r^*" by blast
qed
moreover have "CCR (Restr r (f α))" using b3 by blast
ultimately have "Restr r (f α) ∈ 𝔘 r" unfolding 𝔘_def by blast
then have d3: "∥r∥ ≤o |Restr r (f α)|" using lem_rcc_uset_mem_bnd by blast
obtain x::'U where d4: "True" by blast
have "ω_ord ≤o α ⟶ False"
proof
assume e1: "ω_ord ≤o α"
then have "|f α| ≤o α" using b2 a2 unfolding 𝒩_def 𝒩7_def by blast
moreover then have "|Restr r (f α)| ≤o α" using e1 lem_restr_ordbnd by blast
ultimately have "∥r∥ ≤o α" using d3 ordLeq_transitive by blast
then show "False" using b0 not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
qed
then have "α <o ω_ord" using b0 natLeq_Well_order not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
then have "|f α| <o ω_ord" using b2 a2 unfolding 𝒩_def 𝒩7_def by blast
then have "finite (f α)" using finite_iff_ordLess_natLeq by blast
then have "finite (Restr r (f α))" by blast
then have "|Restr r (f α)| <o ω_ord" using finite_iff_ordLess_natLeq by blast
then have d5: "∥r∥ <o ω_ord" using d3 ordLeq_ordLess_trans by blast
have "∥r∥ ≤o |{x}|"
proof (cases "CCR r")
assume "CCR r"
then show "∥r∥ ≤o |{x}|" using d5 lem_Rcc_eq2_31[of r] lem_Rcc_eq2_12[of r x] by blast
next
assume "¬ CCR r"
moreover then have "∥r∥ = {}" using lem_rcc_nccr by blast
moreover have "{} ≤o |{x}|" by (metis card_of_Well_order ozero_def ozero_ordLeq)
ultimately show "∥r∥ ≤o |{x}|" by metis
qed
then have "α <o |{x}|" using b0 ordLess_ordLeq_trans by blast
then have "α = {}" by (meson lem_co_one_ne_min not_ordLeq_ordLess ordLess_Well_order_simp)
then have "∀ α'. α' <o α ⟶ False" using lem_ord_subemp by (metis iso_ozero_empty not_ordLess_ordIso ordLess_imp_ordLeq ozero_def)
then have "dncl r (𝔏 f α) = {}" unfolding dncl_def 𝔏_def by blast
then have "𝒬 r f α = f α" unfolding 𝒬_def by blast
then show "(𝒬 r f α) ∈ SF r" using b3 by metis
next
assume "¬ (Field r ⊆ dncl r (f α))"
then have "A' ∈ SF r" using b4 b5 by blast
then show "(𝒬 r f α) ∈ SF r" using b1 by blast
qed
qed
lemma lem_der_q_uset:
fixes r::"'U rel" and Ps::"'U set set" and α::"'U rel"
assumes a1: "CCR r" and a2: "f ∈ 𝒩 r Ps" and a3: "α <o scf r" and a4: "isSuccOrd α"
shows "Restr r (𝒬 r f α) ∈ 𝔘 (Restr r (f α))"
proof -
have b1: "α ≤o |Field r|" using a3 lem_scf_relfldcard_bnd
by (metis ordLess_ordLeq_trans ordLess_imp_ordLeq)
have a4: "𝒬 r f α = {} ⟶ False"
proof
assume "𝒬 r f α = {}"
then have "Field r ⊆ dncl r (f α)" using b1 a2 a4 unfolding 𝒩_def 𝒩11_def by blast
then have "α = {}" using a1 a2 a3 lem_Nfdn_aemp by blast
then show "False" using a4 using wo_rel_def wo_rel.isSuccOrd_def unfolding Field_def by force
qed
have "(𝒬 r f α) ∈ SF r" using a1 a2 a3 lem_der_qccr_lscf_sf by blast
then have b2: "Field (Restr r (𝒬 r f α)) ≠ {}" using a4 unfolding SF_def by blast
have "Restr r (𝒬 r f α) ⊆ Restr r (f α)" unfolding 𝒬_def by blast
moreover have "CCR (Restr r (𝒬 r f α))" using b1 a2 lem_der_inf_qrestr_ccr1 by blast
moreover have "∀a∈Field (Restr r (f α)). ∃b∈Field (Restr r (𝒬 r f α)). (a,b) ∈ (Restr r (f α))^*"
proof
fix a
assume c1: "a ∈ Field (Restr r (f α))"
obtain b where c2: "b ∈ Field (Restr r (𝒬 r f α))" using b2 by blast
then have c3: "b ∈ f α ∧ b ∈ 𝒬 r f α" unfolding 𝒬_def Field_def by blast
have "f α ∈ SF r" using b1 a2 unfolding 𝒩_def 𝒩5_def by blast
then have "b ∈ Field (Restr r (f α))" using c3 unfolding SF_def by blast
moreover have "CCR (Restr r (f α))" using b1 a2 unfolding 𝒩_def 𝒩6_def by blast
ultimately obtain c where "c ∈ Field (Restr r (f α))"
and c4: "(a,c) ∈ (Restr r (f α))^* ∧ (b,c) ∈ (Restr r (f α))^*"
using c1 unfolding CCR_def by blast
moreover then have "c ∈ f α" unfolding Field_def by blast
ultimately have "(b, c) ∈ (Restr r (𝒬 r f α))^*" using c3 lem_der_qinv2[of b r f α c] by blast
moreover have "Field (Restr r (𝒬 r f α)) ∈ Inv (Restr r (𝒬 r f α))"
unfolding Inv_def Field_def by blast
ultimately have "c ∈ Field (Restr r (𝒬 r f α))"
using c2 lem_Inv_restr_rtr2[of "Field (Restr r (𝒬 r f α))"] by blast
then show "∃b∈Field (Restr r (𝒬 r f α)). (a, b) ∈ (Restr r (f α))^*" using c4 by blast
qed
ultimately show "Restr r (𝒬 r f α) ∈ 𝔘 (Restr r (f α))" unfolding 𝔘_def by blast
qed
lemma lem_qw_range: "f ∈ 𝒩 r Ps ⟹ α ≤o |Field r| ⟹ 𝒲 r f α ⊆ Field r"
unfolding 𝒩_def 𝒩5_def SF_def Field_def 𝒲_def by blast
lemma lem_der_qw_eq:
fixes r::"'U rel" and Ps::"'U set set" and α β::"'U rel"
assumes "f ∈ 𝒩 r Ps" and "α =o β"
shows "𝒲 r f α = 𝒲 r f β"
proof -
have "f α = f β" using assms unfolding 𝒩_def by blast
moreover have "𝔏 f α = 𝔏 f β" using assms lem_shrel_L_eq by blast
ultimately show ?thesis unfolding 𝒲_def by simp
qed
lemma lem_Der_inf_qw_disj:
fixes r::"'U rel" and α β::"'U rel"
assumes "Well_order α" and "Well_order β"
shows "(¬ (α =o β)) ⟶ (𝒲 r f α) ∩ (𝒲 r f β) = {}"
proof
assume b1: "¬ (α =o β)"
obtain W where b2: "W = (λ α. 𝒲 r f α)" by blast
have "α <o β ∨ β <o α" using b1 assms by (meson not_ordLeq_iff_ordLess ordLeq_iff_ordLess_or_ordIso)
moreover have "∀ α' β'. α' <o β' ⟶ (W α' ∩ W β' ≠ {}) ⟶ False"
proof (intro allI impI)
fix α' β'::"'U rel"
assume d1: "α' <o β'" and "W α' ∩ W β' ≠ {}"
then obtain a where d2: "a ∈ W α' ∩ W β'" by blast
then have "a ∈ f α'" using b2 unfolding 𝒲_def by blast
then have "a ∈ 𝔏 f β'" using d1 unfolding 𝔏_def by blast
then have "a ∉ W β'" using b2 lem_wdn_range_lb[of _ r] unfolding 𝒲_def by blast
then show "False" using d2 by blast
qed
ultimately show "(𝒲 r f α) ∩ (𝒲 r f β) = {}" unfolding b2 by blast
qed
lemma lem_der_inf_qw_restr_card:
fixes r::"'U rel" and Ps::"'U set set" and α::"'U rel"
assumes a1: "¬ finite r" and a2: "f ∈ 𝒩 r Ps" and a3: "α <o |Field r|"
shows "|Restr r (𝒲 r f α)| <o |Field r|"
proof -
have b0: "|Field r| =o |r|" using a1 lem_rel_inf_fld_card by blast
obtain W where b2: "W = (λ α. 𝒲 r f α)" by blast
have "α ≤o |Field r|" using a3 b0 ordLess_imp_ordLeq ordIso_iff_ordLeq ordLeq_transitive by blast
then have "(α <o ω_ord ⟶ |f α| <o ω_ord) ∧ (ω_ord ≤o α ⟶ |f α| ≤o α)"
using a2 unfolding 𝒩_def 𝒩7_def by blast
moreover have c2: "α <o ω_ord ∨ ω_ord ≤o α" using a3 Field_natLeq natLeq_well_order_on by force
moreover have c3: "|f α| <o ω_ord ⟶ |Restr r (W α)| <o |Field r|"
proof
assume "|f α| <o ω_ord"
then have "finite (f α)" using finite_iff_ordLess_natLeq by blast
then have "finite (Restr r (W α))" unfolding b2 𝒲_def by blast
then have "|Restr r (W α)| <o ω_ord" using finite_iff_ordLess_natLeq by blast
moreover have "ω_ord ≤o |r|" using a1 infinite_iff_natLeq_ordLeq by blast
moreover then have "ω_ord ≤o |Field r|" using lem_rel_inf_fld_card
by (metis card_of_ordIso_finite infinite_iff_natLeq_ordLeq)
ultimately show "|Restr r (W α)| <o |Field r|" using ordLess_ordLeq_trans by blast
qed
moreover have "ω_ord ≤o α ∧ |f α| ≤o α ⟶ |Restr r (W α)| <o |Field r|"
proof
assume d1: "ω_ord ≤o α ∧ |f α| ≤o α"
moreover have "|W α| ≤o |f α|" unfolding b2 𝒲_def by simp
ultimately have "|W α| ≤o α" using ordLeq_transitive by blast
then have "|Restr r (W α)| ≤o α" using d1 lem_restr_ordbnd[of α "W α" r] by blast
then show "|Restr r (W α)| <o |Field r|" using a3 ordLeq_ordLess_trans by blast
qed
ultimately show ?thesis using b2 by blast
qed
lemma lem_QS_subs_WS: "𝒬 r f α ⊆ 𝒲 r f α"
unfolding 𝒬_def 𝒲_def using lem_wdn_range_ub by force
lemma lem_WS_limord:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "¬ finite r" and a2: "f ∈ 𝒩 r Ps" and a3: "α <o |Field r|"
and a4: "¬ (α = {} ∨ isSuccOrd α)"
shows "𝒲 r f α = {}"
proof -
have "α ≤o |Field r|" using a3 ordLess_imp_ordLeq by blast
then have "f α ⊆ 𝔏 f α" using a2 a4 unfolding 𝒩_def 𝒩2_def Dbk_def by blast
then have "w_dncl r (f α) ⊆ w_dncl r (𝔏 f α)" using lem_wdn_mon by blast
moreover have "f α ⊆ w_dncl r (f α)" using lem_wdn_range_lb[of "f α" r] by metis
ultimately have "f α ⊆ w_dncl r (𝔏 f α)" by blast
then show ?thesis unfolding 𝒲_def by blast
qed
lemma lem_der_inf_qw_restr_uset:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "Refl r ∧ ¬ finite r" and a2: "f ∈ 𝒩 r Ps"
and a3: "α <o |Field r|" and a4: "ω_ord ≤o |𝔏 f α|"
shows "Restr r (𝒬 r f α) ∈ 𝔘 (Restr r (𝒲 r f α))"
proof (cases "α = {} ∨ isSuccOrd α")
assume "α = {} ∨ isSuccOrd α"
moreover have "|Field r| =o |r|" using a1 lem_rel_inf_fld_card by blast
then have b1: "α ≤o |Field r|" using a3 ordLess_imp_ordLeq ordIso_iff_ordLeq ordLeq_transitive by blast
ultimately have b2: "escl r (𝔏 f α) (f α) ⊆ f α" using a2 a4 unfolding 𝒩_def 𝒩3_def by blast
moreover have b3: "CCR (Restr r (f α))" using b1 a2 unfolding 𝒩_def 𝒩6_def by blast
moreover have "SF r = {A. A ⊆ Field r}" using a1 unfolding SF_def refl_on_def Field_def by fast
moreover then have "𝒲 r f α ∈ SF r" and "𝒬 r f α ∈ SF r"
using a2 a3 lem_qw_range[of f r Ps α] lem_QS_subs_WS[of r f α] ordLess_imp_ordLeq by fast+
ultimately show ?thesis
using a1 lem_cowdn_uset[of r "f α" "𝔏 f α"] 𝒬_def[of r f α] 𝒲_def[of r f α] by blast
next
assume "¬ (α = {} ∨ isSuccOrd α)"
then have "𝒲 r f α = {} ∧ 𝒬 r f α = {}"
using assms lem_WS_limord lem_QS_subs_WS[of r f α] by blast
then show ?thesis unfolding 𝔘_def CCR_def Field_def by blast
qed
lemma lem_der_inf_qw_restr_ccr:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "Refl r ∧ ¬ finite r" and a2: "f ∈ 𝒩 r Ps"
and a3: "α <o |Field r|" and a4: "ω_ord ≤o |𝔏 f α|"
shows "CCR (Restr r (𝒲 r f α))"
using assms lem_der_inf_qw_restr_uset lem_rcc_uset_ne_ccr by blast
lemma lem_der_qw_uset:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "CCR r ∧ Refl r ∧ ¬ finite r" and a2: "f ∈ 𝒩 r Ps"
and a3: "α <o scf r" and a4: "ω_ord ≤o |𝔏 f α|" and a5: "isSuccOrd α"
shows "Restr r (𝒲 r f α) ∈ 𝔘 (Restr r (f α))"
proof -
have b1: "α <o |Field r|" using a3 lem_scf_relfldcard_bnd by (metis ordLess_ordLeq_trans)
have "𝒬 r f α ⊆ 𝒲 r f α" using lem_QS_subs_WS[of r f α] by blast
then have "Field (Restr r (𝒬 r f α)) ⊆ Field (Restr r (𝒲 r f α))" unfolding Field_def by blast
moreover have "Restr r (𝒬 r f α) ∈ 𝔘 (Restr r (f α))"
using a1 a2 a3 a5 lem_der_q_uset ordLess_imp_ordLeq by blast
ultimately have "∀a∈Field (Restr r (f α)). ∃b∈Field (Restr r (𝒲 r f α)).
(a,b) ∈ (Restr r (f α))^*" unfolding 𝔘_def by blast
moreover have "Restr r (𝒲 r f α) ⊆ Restr r (f α)" unfolding 𝒲_def by blast
moreover have "CCR (Restr r (𝒲 r f α))" using assms b1 lem_der_inf_qw_restr_ccr by blast
ultimately show ?thesis unfolding 𝔘_def by blast
qed
lemma lem_Shinf_N1:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
shows "∀α. Well_order α ⟶ f ∈ 𝒩1 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩1 r {}" using b2 unfolding 𝒩1_def by (clarsimp, metis lem_ord_subemp)
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩1 r α0 ⟶ f ∈ 𝒩1 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩1 r α0"
then have c2: "f α = F α0 (f α0)" using b3 by blast
have "∀α' α''. α' ≤o α ∧ α'' ≤o α' ⟶ f α'' ⊆ f α'"
proof (intro allI impI)
fix α' α''::"'U rel"
assume d1: "α' ≤o α ∧ α'' ≤o α'"
moreover then have "α'' ≤o α" using ordLeq_transitive by blast
ultimately have "(α'' ≤o α0 ∨ α'' =o α) ∧ (α' ≤o α0 ∨ α' =o α)" using c1 unfolding sc_ord_def
by (meson not_ordLess_iff_ordLeq ordLeq_iff_ordLess_or_ordIso ordLess_Well_order_simp)
moreover have "α' ≤o α0 ⟶ f α'' ⊆ f α'" using d1 c1 unfolding 𝒩1_def by blast
moreover have "α' =o α ∧ α'' =o α ⟶ f α'' ⊆ f α'" using b5 by blast
moreover have "α' =o α ∧ α'' ≤o α0 ⟶ f α'' ⊆ f α'"
proof
assume e1: "α' =o α ∧ α'' ≤o α0"
moreover then have "α0 ≤o α0" using ordLeq_Well_order_simp ordLeq_reflexive by blast
ultimately have "f α'' ⊆ f α0" using c1 unfolding 𝒩1_def by blast
moreover have "f α0 ⊆ f α" using a1 c2 e1 ordLeq_Well_order_simp by blast
ultimately show "f α'' ⊆ f α'" using b5 e1 by blast
qed
ultimately show "f α'' ⊆ f α'" by blast
qed
then show "f ∈ 𝒩1 r α" unfolding 𝒩1_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩1 r β) ⟶ f ∈ 𝒩1 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩1 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α' α''. α' ≤o α ∧ α'' ≤o α' ⟶ f α'' ⊆ f α'"
proof (intro allI impI)
fix α' α''::"'U rel"
assume d1: "α' ≤o α ∧ α'' ≤o α'"
then have "(α' <o α ∨ α' =o α) ∧ (α'' <o α' ∨ α'' =o α')" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ f α'' ⊆ f α'"
using d1 c1 ordLeq_Well_order_simp ordLeq_reflexive unfolding 𝒩1_def by blast
moreover have "α' =o α ∧ α'' <o α' ⟶ f α'' ⊆ f α'"
using c2 b5 ordLess_ordIso_trans by blast
moreover have "α' =o α ∧ α'' =o α' ⟶ f α'' ⊆ f α'" using b5 by blast
ultimately show "f α'' ⊆ f α'" by blast
qed
then show "f ∈ 𝒩1 r α" unfolding 𝒩1_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩1 r α"] by blast
qed
lemma lem_Shinf_N2:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
shows "∀α. Well_order α ⟶ f ∈ 𝒩2 r α"
proof -
have b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩2 r {}" using lem_ord_subemp unfolding 𝒩2_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩2 r α0 ⟶ f ∈ 𝒩2 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩2 r α0"
have "∀α'::'U rel. α' ≤o α ∧ ¬ (α' = {} ∨ isSuccOrd α') ⟶ (∇ f α') = {}"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ ¬ (α' = {} ∨ isSuccOrd α')"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ (∇ f α') = {}" using d1 c1 unfolding 𝒩2_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ False"
proof
assume "α =o α'"
moreover have "isSuccOrd α" using c1 lem_ordint_sucord[of α0 α] unfolding sc_ord_def by blast
ultimately have "isSuccOrd α'" using lem_osucc_eq by blast
then show "False" using d1 by blast
qed
ultimately show "(∇ f α') = {}" by blast
qed
then show "f ∈ 𝒩2 r α" unfolding 𝒩2_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩2 r β) ⟶ f ∈ 𝒩2 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩2 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ∧ ¬ (α' = {} ∨ isSuccOrd α') ⟶ (∇ f α') = {}"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ ¬ (α' = {} ∨ isSuccOrd α')"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ (∇ f α') = {}"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "(∇ f α') = {}" using c1 d1 unfolding 𝒩2_def by blast
qed
moreover have "α' =o α ⟶ (∇ f α') = {}"
proof
assume "α' =o α"
moreover have "(∇ f α) = {}" using c2 unfolding Dbk_def 𝔏_def by blast
ultimately show "(∇ f α') = {}" using b5 lem_shrel_L_eq unfolding Dbk_def by blast
qed
ultimately show "(∇ f α') = {}" by blast
qed
then show "f ∈ 𝒩2 r α" unfolding 𝒩2_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩2 r α"] by blast
qed
lemma lem_Shinf_N3:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a3: "∀ α A. Well_order α ⟶ A ∈ SF r ⟶
(ω_ord ≤o |A| ⟶ escl r A (F α A) ⊆ (F α A) ∧ clterm (Restr r (F α A)) r)"
shows "∀α. Well_order α ⟶ f ∈ 𝒩3 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "𝔏 f {} = {}" unfolding 𝔏_def using b2 lem_ord_subemp ordLess_imp_ordLeq by blast
then have "¬ ω_ord ≤o |𝔏 f {}|" using ctwo_ordLess_natLeq finite_iff_ordLess_natLeq ordLeq_transitive by auto
then have "f ∈ 𝒩3 r {}" using b2 lem_ord_subemp unfolding 𝒩3_def Field_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩3 r α0 ⟶ f ∈ 𝒩3 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩3 r α0"
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶ (ω_ord ≤o |𝔏 f α'| ⟶
escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')" and d2: "ω_ord ≤o |𝔏 f α'|"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ (ω_ord ≤o |𝔏 f α'| ⟶
escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
using d1 c1 unfolding 𝒩3_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ (ω_ord ≤o |𝔏 f α'| ⟶
escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
proof (intro impI)
assume e1: "α =o α'" and e2: "ω_ord ≤o |𝔏 f α'|"
have "𝔏 f α ⊆ f α0"
proof
fix p
assume "p ∈ 𝔏 f α"
then obtain β::"'U rel" where "β <o α ∧ p ∈ f β" unfolding 𝔏_def by blast
moreover then have "β ≤o α0 ∧ α0 ≤o α0" using c1 unfolding sc_ord_def
using not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
moreover then have "f ∈ 𝒩1 r α0" using a0 a1 lem_Shinf_N1[of f F] ordLeq_Well_order_simp by metis
ultimately show "p ∈ f α0" unfolding 𝒩1_def by blast
qed
moreover have "f α0 ⊆ 𝔏 f α" using c1 unfolding sc_ord_def 𝔏_def by blast
ultimately have e3: "𝔏 f α = f α0" by blast
then have "ω_ord ≤o |f α0|" using e1 e2 lem_shrel_L_eq by metis
moreover have "Well_order α0" using c1 unfolding sc_ord_def ordLess_def by blast
moreover then have "(f α0) ∈ SF r"
using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
moreover have "f α = F α0 (f α0)" using c1 b3 by blast
ultimately have e4: "escl r (f α0) (f α) ⊆ f α ∧ clterm (Restr r (f α)) r" using a3 by metis
then have "escl r (𝔏 f α) (f α) ⊆ f α" using e3 by simp
then have "escl r (𝔏 f α') (f α') ⊆ f α'" using e1 b5 lem_shrel_L_eq by metis
moreover have "clterm (Restr r (f α')) r" using e1 e4 b5 by metis
ultimately show "escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r" by blast
qed
ultimately show "escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r" using d2 by blast
qed
then show "f ∈ 𝒩3 r α" unfolding 𝒩3_def by blast
qed
moreover have "∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩3 r β) ⟶ f ∈ 𝒩3 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩3 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶ (ω_ord ≤o |𝔏 f α'| ⟶
escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')" and d2: "ω_ord ≤o |𝔏 f α'|"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ (ω_ord ≤o |𝔏 f α'| ⟶
escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "(ω_ord ≤o |𝔏 f α'| ⟶ escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r)"
using c1 d1 unfolding 𝒩3_def by blast
qed
moreover have "α' =o α ⟶ False"
proof
assume "α' =o α"
moreover then have "α' = {} ∨ isSuccOrd α" using d1 lem_osucc_eq by blast
moreover have "¬ (α = {} ∨ isSuccOrd α)" using c1 unfolding lm_ord_def by blast
ultimately have "α' =o α ∧ α' = {} ∧ α ≠ {}" by blast
then show "False" by (metis iso_ozero_empty ordIso_symmetric ozero_def)
qed
ultimately show "escl r (𝔏 f α') (f α') ⊆ f α' ∧ clterm (Restr r (f α')) r" using d2 by blast
qed
then show "f ∈ 𝒩3 r α" unfolding 𝒩3_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩3 r α"] by blast
qed
lemma lem_Shinf_N4:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a4: "∀ α A. Well_order α ⟶ A ∈ SF r ⟶ (∀ a∈A. r``{a} ⊆ w_dncl r A ∨ r``{a} ∩ (F α A - w_dncl r A) ≠ {})"
shows "∀α. Well_order α ⟶ f ∈ 𝒩4 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "𝔏 f {} = {}" unfolding 𝔏_def using lem_ord_subemp ordLeq_iff_ordLess_or_ordIso ordLess_irreflexive by blast
then have "f ∈ 𝒩4 r {}" using lem_ord_subemp unfolding 𝒩4_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩4 r α0 ⟶ f ∈ 𝒩4 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩4 r α0"
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶
( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ ( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
using d1 c1 unfolding 𝒩4_def Dbk_def 𝒲_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ ( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
proof
assume e1: "α =o α'"
have "Well_order α0" using c1 unfolding sc_ord_def ordLess_def by blast
moreover then have "(f α0) ∈ SF r"
using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
moreover have "f α = F α0 (f α0)" using c1 b3 by blast
ultimately have e2: "∀a ∈ (f α0). r``{a} ⊆ w_dncl r (f α0) ∨ r``{a}∩(f α - w_dncl r (f α0))≠{}"
using a4 by metis
have "𝔏 f α ⊆ f α0"
proof
fix p
assume "p ∈ 𝔏 f α"
then obtain β::"'U rel" where "β <o α ∧ p ∈ f β" unfolding 𝔏_def by blast
moreover then have "β ≤o α0 ∧ α0 ≤o α0" using c1 unfolding sc_ord_def
using not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
moreover then have "f ∈ 𝒩1 r α0" using a0 a1 lem_Shinf_N1[of f F] ordLeq_Well_order_simp by metis
ultimately show "p ∈ f α0" unfolding 𝒩1_def by blast
qed
moreover have "f α0 ⊆ 𝔏 f α" using c1 unfolding sc_ord_def 𝔏_def by blast
ultimately have "𝔏 f α = f α0" by blast
then have "𝔏 f α' = f α0" using e1 lem_shrel_L_eq by blast
then show "∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{}"
using e2 e1 b5 by metis
qed
ultimately show "∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{}" by blast
qed
then show "f ∈ 𝒩4 r α" unfolding 𝒩4_def Dbk_def 𝒲_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩4 r β) ⟶ f ∈ 𝒩4 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩4 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶
( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ ( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "( ∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{} )"
using c1 d1 unfolding 𝒩4_def Dbk_def 𝒲_def by blast
qed
moreover have "α' =o α ⟶ False"
proof
assume "α' =o α"
moreover then have "α' = {} ∨ isSuccOrd α" using d1 lem_osucc_eq by blast
moreover have "¬ (α = {} ∨ isSuccOrd α)" using c1 unfolding lm_ord_def by blast
ultimately have "α' =o α ∧ α' = {} ∧ α ≠ {}" by blast
then show "False" by (metis iso_ozero_empty ordIso_symmetric ozero_def)
qed
ultimately show "∀a ∈ (𝔏 f α'). r``{a} ⊆ w_dncl r (𝔏 f α') ∨ r``{a}∩(f α' - w_dncl r (𝔏 f α'))≠{}" by blast
qed
then show "f ∈ 𝒩4 r α" unfolding 𝒩4_def Dbk_def 𝒲_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩4 r α"] by blast
qed
lemma lem_Shinf_N5:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
assumes a5: "∀ α A. (Well_order α ∧ A ∈ SF r) ⟶ (F α A) ∈ SF r"
shows "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩5 r {}" using b2 lem_ord_subemp unfolding 𝒩5_def SF_def Field_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩5 r α0 ⟶ f ∈ 𝒩5 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩5 r α0"
have "∀α'::'U rel. α' ≤o α ⟶ (f α') ∈ SF r"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ Field (Restr r (f α')) = (f α')" using c1 unfolding 𝒩5_def SF_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ (f α') ∈ SF r"
proof
assume "α =o α'"
moreover have "(f α) ∈ SF r"
proof -
have "α0 ≤o α0" using c1 unfolding sc_ord_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
then have "(f α0) ∈ SF r" using c1 unfolding 𝒩5_def by blast
moreover have "Well_order α0" using c1 unfolding sc_ord_def using ordLess_Well_order_simp by blast
moreover have "f α = F α0 (f α0)" using c1 b3 by blast
ultimately show "(f α) ∈ SF r" using a5 by metis
qed
ultimately show "(f α') ∈ SF r" using b5 by metis
qed
ultimately show "(f α') ∈ SF r" unfolding SF_def by blast
qed
then show "f ∈ 𝒩5 r α" unfolding 𝒩5_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩5 r β) ⟶ f ∈ 𝒩5 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩5 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ⟶ (f α') ∈ SF r"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ Field (Restr r (f α')) = (f α')"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "Field (Restr r (f α')) = (f α')" using c1 d1 unfolding 𝒩5_def SF_def by blast
qed
moreover have "α' =o α ⟶ (f α') ∈ SF r"
proof
assume "α' =o α"
moreover have "(f α) ∈ SF r"
proof -
have "∀ β. β <o α ⟶ (f β) ∈ SF r" using c1 unfolding 𝒩5_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
then show ?thesis using c2 lem_Relprop_sat_un[of "{D. ∃β. β <o α ∧ D = f β}" r "f α"] unfolding SF_def by blast
qed
ultimately show "(f α') ∈ SF r" using b5 by metis
qed
ultimately show "(f α') ∈ SF r" unfolding SF_def by blast
qed
then show "f ∈ 𝒩5 r α" unfolding 𝒩5_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩5 r α"] by blast
qed
lemma lem_Shinf_N6:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a6: "∀ α A. Well_order α ⟶ A ∈ SF r ⟶ CCR (Restr r (F α A))"
shows "∀α. Well_order α ⟶ f ∈ 𝒩6 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩6 r {}" using b2 lem_ord_subemp unfolding 𝒩6_def CCR_def Field_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩6 r α0 ⟶ f ∈ 𝒩6 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩6 r α0"
then have c2: "f α = F α0 (f α0)" using b3 by blast
have "∀α'. α' ≤o α ⟶ CCR (Restr r (f α'))"
proof (intro allI impI)
fix α'::"'U rel"
assume "α' ≤o α"
then have "α' ≤o α0 ∨ α' =o α" using c1 unfolding sc_ord_def
by (meson ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_Well_order_simp ordLess_or_ordLeq)
moreover have "α' ≤o α0 ⟶ CCR (Restr r (f α'))" using c1 unfolding 𝒩6_def by blast
moreover have "α' =o α ⟶ CCR (Restr r (f α'))"
proof
assume "α' =o α"
moreover have "CCR (Restr r (f α))"
proof -
have "Well_order α0"
using c1 ordLess_Well_order_simp unfolding sc_ord_def by blast
moreover then have "(f α0) ∈ SF r"
using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
ultimately show "CCR (Restr r (f α))" unfolding c2 using a6 by blast
qed
ultimately show "CCR (Restr r (f α'))" using b5 by metis
qed
ultimately show "CCR (Restr r (f α'))" by blast
qed
then show "f ∈ 𝒩6 r α" unfolding 𝒩6_def by blast
qed
moreover have "∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩6 r β) ⟶ f ∈ 𝒩6 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩6 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have c3: "∀α'. α' ≤o α ⟶ CCR (Restr r (f α'))"
proof (intro allI impI)
fix α'::"'U rel"
assume "α' ≤o α"
then have "α' <o α ∨ α' =o α" using ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_or_ordLeq by blast
moreover have "α' <o α ⟶ CCR (Restr r (f α'))" using c1 unfolding 𝒩6_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
moreover have "α' =o α ⟶ CCR (Restr r (f α'))"
proof
assume "α' =o α"
moreover have "CCR (Restr r (f α))"
proof -
obtain C where f1: "C = { A. ∃ β::'U rel. β <o α ∧ A = f β }" by blast
obtain S where f2: "S = { s. ∃ A ∈ C. s = Restr r A }" by blast
have f3: "∀A1 ∈ C. ∀A2 ∈ C. A1 ⊆ A2 ∨ A2 ⊆ A1"
proof (intro ballI)
fix A1 A2
assume "A1 ∈ C" and "A2 ∈ C"
then obtain β1 β2::"'U rel" where "A1 = f β1 ∧ A2 = f β2 ∧ β1 <o α ∧ β2 <o α" using f1 by blast
moreover then have "(β1 ≤o β2 ∨ β2 ≤o β1) ∧ β1 ≤o α ∧ β2 ≤o α"
using ordLeq_total ordLess_Well_order_simp ordLess_imp_ordLeq by blast
moreover have "f ∈ 𝒩1 r α" using a0 a1 c1 lem_Shinf_N1[of f F r] unfolding lm_ord_def by blast
ultimately show "A1 ⊆ A2 ∨ A2 ⊆ A1" unfolding 𝒩1_def by blast
qed
have "∀ s ∈ S. CCR s" using f1 f2 c1 unfolding 𝒩6_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
moreover have "∀s1∈S. ∀s2∈S. s1 ⊆ s2 ∨ s2 ⊆ s1" using f2 f3 by blast
ultimately have "CCR (⋃ S)" using lem_Relprop_ccr_ch_un[of S] by blast
moreover have "Restr r ( ⋃ {D. ∃β. β <o α ∧ D = f β} ) = ⋃ S"
using f1 f2 f3 lem_Relprop_restr_ch_un[of C r] by blast
ultimately show ?thesis unfolding c2 by simp
qed
ultimately show "CCR (Restr r (f α'))" using b5 by metis
qed
ultimately show "CCR (Restr r (f α'))" by blast
qed
then show "f ∈ 𝒩6 r α" unfolding 𝒩6_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩6 r α"] by blast
qed
lemma lem_Shinf_N7:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a7: "∀ α A. ( |A| <o ω_ord ⟶ |F α A| <o ω_ord )
∧ ( ω_ord ≤o |A| ⟶ |F α A| ≤o |A| ) "
shows "∀α. Well_order α ⟶ f ∈ 𝒩7 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "∀α::'U rel. α ≤o {} ⟶ |f α| ≤o α ∧ |f α| <o ω_ord"
proof (intro allI impI)
fix α::"'U rel"
assume "α ≤o {}"
moreover then have "(f α) = {}" using b2 lem_ord_subemp by blast
ultimately show "|f α| ≤o α ∧ |f α| <o ω_ord" using lem_ord_subemp
by (metis Field_natLeq card_of_empty1 card_of_empty5 ctwo_def ctwo_ordLess_natLeq natLeq_well_order_on not_ordLeq_iff_ordLess ordLeq_Well_order_simp)
qed
then have "f ∈ 𝒩7 r {}" unfolding 𝒩7_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩7 r α0 ⟶ f ∈ 𝒩7 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩7 r α0"
then have c2: "f α = F α0 (f α0)" using b3 by blast
have "∀α'. α' ≤o α ∧ ω_ord ≤o α' ⟶ |f α'| ≤o α'"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ ω_ord ≤o α'"
then have "α' ≤o α0 ∨ α' =o α" using c1 unfolding sc_ord_def
by (meson ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_Well_order_simp ordLess_or_ordLeq)
moreover have "α' ≤o α0 ⟶ |f α'| ≤o α'" using c1 d1 unfolding 𝒩7_def by blast
moreover have "α' =o α ⟶ |f α'| ≤o α'"
proof
assume e1: "α' =o α"
then have e2: "ω_ord ≤o α" using d1 b5 ordLeq_transitive by blast
then have e3: "ω_ord ≤o α0" using c1 lem_ord_suc_ge_w by blast
then have "Well_order α0 ∧ |f α0| ≤o α0"
using c1 unfolding sc_ord_def 𝒩7_def using ordLess_Well_order_simp ordLeq_reflexive by blast
moreover then have "|f α| ≤o |f α0| ∨ |f α| <o ω_ord" unfolding c2 using a7
using finite_iff_ordLess_natLeq infinite_iff_natLeq_ordLeq by blast
moreover have "α0 ≤o α" using c1 unfolding sc_ord_def using ordLess_imp_ordLeq by blast
ultimately have "|f α| ≤o α" using e3 ordLeq_transitive ordLess_imp_ordLeq by metis
then show "|f α'| ≤o α'" using b5 e1 ordIso_iff_ordLeq ordLeq_transitive by metis
qed
ultimately show "|f α'| ≤o α'" by blast
qed
moreover have "∀α'. α' ≤o α ∧ α' <o ω_ord ⟶ |f α'| <o ω_ord"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ α' <o ω_ord"
then have "α' ≤o α0 ∨ α' =o α" using c1 unfolding sc_ord_def
by (meson ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_Well_order_simp ordLess_or_ordLeq)
moreover have "α' ≤o α0 ⟶ |f α'| <o ω_ord" using c1 d1 unfolding 𝒩7_def by blast
moreover have "α' =o α ⟶ |f α'| <o ω_ord"
proof
assume e1: "α' =o α"
then have e2: "α <o ω_ord" using d1 ordIso_iff_ordLeq ordIso_ordLess_trans by blast
then have e3: "α0 <o ω_ord" using c1 unfolding sc_ord_def using ordLeq_ordLess_trans ordLess_imp_ordLeq by blast
then have "Well_order α0 ∧ |f α0| <o ω_ord"
using c1 unfolding sc_ord_def 𝒩7_def using ordLess_Well_order_simp ordLeq_reflexive by blast
then have "|f α| <o ω_ord" unfolding c2 using a7 by blast
then show "|f α'| <o ω_ord" using b5 e1 by metis
qed
ultimately show "|f α'| <o ω_ord" by blast
qed
ultimately show "f ∈ 𝒩7 r α" unfolding 𝒩7_def by blast
qed
moreover have "∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩7 r β) ⟶ f ∈ 𝒩7 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩7 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'. α' ≤o α ∧ ω_ord ≤o α' ⟶ |f α'| ≤o α'"
proof (intro allI impI)
fix α'::"'U rel"
assume e1: "α' ≤o α ∧ ω_ord ≤o α'"
then have "α' <o α ∨ α' =o α" using ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_or_ordLeq by blast
moreover have "α' <o α ⟶ |f α'| ≤o α'" using c1 e1 unfolding 𝒩7_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
moreover have "α' =o α ⟶ |f α'| ≤o α'"
proof
assume "α' =o α"
moreover have "|f α| ≤o α"
proof -
obtain S where f1: "S = { A. ∃ β::'U rel. β <o α ∧ A = f β }" by blast
have f2: "ω_ord ≤o α" using c1 lem_lmord_inf lem_inford_ge_w unfolding lm_ord_def by blast
have f3: "∀ s ∈ S. |s| ≤o α"
proof
fix s
assume "s ∈ S"
then obtain β where "β <o α ∧ s = f β" using f1 by blast
then show "|s| ≤o α"
using c1 f2 unfolding 𝒩7_def apply clarsimp
by (metis card_of_Well_order natLeq_Well_order not_ordLess_ordLeq ordLeq_reflexive ordLess_Well_order_simp ordLess_or_ordLeq ordLess_transitive)
qed
moreover have "|S| ≤o α"
proof -
have "f ` {γ. γ <o α} = S" using f1 by force
then show ?thesis using f1 f2 b5 lem_ord_int_card_le_inf[of f α ] by blast
qed
ultimately have "|⋃ S| ≤o α" using f2 lem_card_un_bnd[of S α] by blast
then show ?thesis unfolding f1 c2 by blast
qed
ultimately show "|f α'| ≤o α'" using b5 ordIso_iff_ordLeq ordLeq_transitive by metis
qed
ultimately show "|f α'| ≤o α'" by blast
qed
moreover have "∀α'. α' ≤o α ∧ α' <o ω_ord ⟶ |f α'| <o ω_ord"
proof (intro allI impI)
fix α'::"'U rel"
assume e1: "α' ≤o α ∧ α' <o ω_ord"
then have "α' <o α ∨ α' =o α" using ordIso_iff_ordLeq ordLeq_Well_order_simp ordLess_or_ordLeq by blast
moreover have "α' <o α ⟶ |f α'| <o ω_ord" using c1 e1 unfolding 𝒩7_def
using ordLess_Well_order_simp ordLeq_reflexive by blast
moreover have "α' =o α ⟶ |f α'| <o ω_ord"
proof
assume "α' =o α"
moreover have "|f α| ≤o α"
proof -
obtain S where f1: "S = { A. ∃ β::'U rel. β <o α ∧ A = f β }" by blast
have f2: "ω_ord ≤o α" using c1 lem_lmord_inf lem_inford_ge_w unfolding lm_ord_def by blast
have f3: "∀ s ∈ S. |s| ≤o α"
proof
fix s
assume "s ∈ S"
then obtain β where "β <o α ∧ s = f β" using f1 by blast
then show "|s| ≤o α"
using c1 f2 unfolding 𝒩7_def apply clarsimp
by (metis card_of_Well_order natLeq_Well_order not_ordLess_ordLeq ordLeq_reflexive ordLess_Well_order_simp ordLess_or_ordLeq ordLess_transitive)
qed
moreover have "|S| ≤o α"
proof -
have "f ` {γ. γ <o α} = S" using f1 by force
then show ?thesis using f1 f2 b5 lem_ord_int_card_le_inf[of f α ] by blast
qed
ultimately have "|⋃ S| ≤o α" using f2 lem_card_un_bnd[of S α] by blast
then show ?thesis unfolding f1 c2 by blast
qed
ultimately show "|f α'| <o ω_ord" using e1 b5 ordIso_iff_ordLeq ordLeq_transitive
by (metis card_of_Well_order natLeq_Well_order not_ordLess_ordLeq ordLess_or_ordLeq)
qed
ultimately show "|f α'| <o ω_ord" by blast
qed
ultimately show "f ∈ 𝒩7 r α" unfolding 𝒩7_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩7 r α"] by blast
qed
lemma lem_Shinf_N8:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set" and Ps::"'U set set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a7: "∀ α A. ( |A| <o ω_ord ⟶ |F α A| <o ω_ord )
∧ ( ω_ord ≤o |A| ⟶ |F α A| ≤o |A| ) "
and a8: "∀α A. A ∈ SF r ⟶ ℰp r Ps A (F α A)"
shows "∀α. Well_order α ⟶ f ∈ 𝒩8 r Ps α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩8 r Ps {}" using b2 lem_ord_subemp unfolding 𝒩8_def SCF_def Field_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩8 r Ps α0 ⟶ f ∈ 𝒩8 r Ps α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩8 r Ps α0"
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶
((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶ (∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
proof (intro allI, rule impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ ((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶
(∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
using d1 c1 unfolding 𝒩8_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ ((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶
(∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
proof (intro ballI impI)
fix P
assume e1: "α =o α'" and e2: "(∃P'. Ps = {P'}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )" and e3: "P ∈ Ps"
have e4: "f α' = f α" using b5 e1 by blast
have "Well_order α0" using c1 unfolding sc_ord_def ordLess_def by blast
then have "(f α0) ∈ SF r" using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
moreover have e5: "f α = F α0 (f α0)" using c1 b3 by blast
moreover have "¬ (∃P'. Ps = {P'}) ⟶ (¬ finite Ps ∧ |Ps| ≤o |f α0| )"
proof
assume f1: "¬ (∃P'. Ps = {P'})"
then have f2: "ω_ord ≤o |Ps| ∧ |Ps| ≤o |f α|" using e2 e4 infinite_iff_natLeq_ordLeq by metis
then have "¬ |F α0 (f α0)| <o ω_ord" using e5
by (metis finite_ordLess_infinite2 infinite_iff_natLeq_ordLeq not_ordLess_ordLeq)
then have "¬ |f α0| <o ω_ord" using a7 by blast
then have "ω_ord ≤o |f α0|" by (metis finite_iff_ordLess_natLeq infinite_iff_natLeq_ordLeq)
then have "|F α0 (f α0)| ≤o |f α0|" using a7 by blast
then have "|Ps| ≤o |f α0|" using f2 e5 ordLeq_transitive by metis
then show "¬ finite Ps ∧ |Ps| ≤o |f α0|" using f1 e2 by blast
qed
ultimately show "f α' ∩ P ∈ SCF (Restr r (f α'))" using e3 e4 a8 unfolding ℰp_def by metis
qed
ultimately show "((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶ (∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))" by blast
qed
then show "f ∈ 𝒩8 r Ps α" unfolding 𝒩8_def by blast
qed
moreover have "∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩8 r Ps β) ⟶ f ∈ 𝒩8 r Ps α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩8 r Ps β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ∧ (α' = {} ∨ isSuccOrd α') ⟶
((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶ (∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
proof (intro allI, rule impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (α' = {} ∨ isSuccOrd α')"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ ((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶
(∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶
(∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))"
using c1 d1 unfolding 𝒩8_def by blast
qed
moreover have "α' =o α ⟶ False"
proof
assume "α' =o α"
moreover then have "α' = {} ∨ isSuccOrd α" using d1 lem_osucc_eq by blast
moreover have "¬ (α = {} ∨ isSuccOrd α)" using c1 unfolding lm_ord_def by blast
ultimately have "α' =o α ∧ α' = {} ∧ α ≠ {}" by blast
then show "False" by (metis iso_ozero_empty ordIso_symmetric ozero_def)
qed
ultimately show "((∃P. Ps = {P}) ∨ (¬ finite Ps ∧ |Ps| ≤o |f α'| )) ⟶
(∀P∈Ps. f α' ∩ P ∈ SCF (Restr r (f α')))" by blast
qed
then show "f ∈ 𝒩8 r Ps α" unfolding 𝒩8_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩8 r Ps α"] by blast
qed
lemma lem_Shinf_N9:
fixes r::"'U rel" and g::"'U rel ⇒ 'U"
and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a2: "∀ α A. Well_order α ⟶ g α ∈ Field r ⟶ g α ∈ F α A"
and a11: "ω_ord ≤o |Field r| ⟶ Field r ⊆ g ` { γ::'U rel. γ <o |Field r| }"
shows "f ∈ 𝒩9 r |Field r|"
proof -
have b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))" using a0 unfolding 𝒯_def by blast+
have "∀ a ∈ Field r. ω_ord ≤o |Field r| ⟶ a ∈ f |Field r|"
proof (intro ballI impI)
fix a
assume c1: "a ∈ Field r" and c2: "ω_ord ≤o |Field r|"
then obtain α0::"'U rel" where c4: "α0 <o |Field r| ∧ g α0 = a" using a11 by blast
moreover then obtain α where c5: "sc_ord α0 α" using lem_sucord_ex[of α0 "|Field r|"] by blast
ultimately have c6: "α ≤o |Field r|" unfolding sc_ord_def by blast
have "Well_order |Field r|" by simp
then have "f ∈ 𝒩1 r |Field r|" using a0 a1 lem_Shinf_N1 unfolding card_order_on_def by metis
moreover have c7: "|Field r| ≤o |Field r|" by simp
moreover have "f α = F α0 (f α0)" using c5 b3 by blast
moreover have "a ∈ F α0 (f α0)" using a2 c4 c1 ordLess_Well_order_simp by blast
ultimately show "a ∈ f |Field r|" using c6 unfolding 𝒩1_def by blast
qed
then show ?thesis unfolding 𝒩9_def by blast
qed
lemma lem_Shinf_N10:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a10: "∀ α A. Well_order α ⟶ A ∈ SF r ⟶
((∃y. (F α A) - dncl r A ⊆ {y}) ⟶ (Field r ⊆ dncl r (F α A)))"
shows "∀α. Well_order α ⟶ f ∈ 𝒩10 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "f ∈ 𝒩10 r {}" using b2 lem_ord_subemp unfolding 𝒩10_def 𝒬_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩10 r α0 ⟶ f ∈ 𝒩10 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩10 r α0"
have "∀α'::'U rel. α' ≤o α ⟶
((∃y. (f α') - dncl r (𝔏 f α') = {y}) ⟶ (Field r ⊆ dncl r (f α')))"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α" and d2: "∃y. (f α') - dncl r (𝔏 f α') = {y}"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ ((∃y. (f α') - dncl r (𝔏 f α') = {y}) ⟶ (Field r ⊆ dncl r (f α')))"
using d1 c1 unfolding 𝒩10_def 𝒬_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ (Field r ⊆ dncl r (f α'))"
proof
assume e1: "α =o α'"
have "Well_order α0" using c1 unfolding sc_ord_def ordLess_def by blast
moreover then have "(f α0) ∈ SF r"
using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
moreover have "f α = F α0 (f α0)" using c1 b3 by blast
ultimately have e2: "((∃y. (f α) - dncl r (f α0) ⊆ {y}) ⟶ (Field r ⊆ dncl r (f α)))"
using a10 by metis
have "𝔏 f α ⊆ f α0"
proof
fix p
assume "p ∈ 𝔏 f α"
then obtain β::"'U rel" where "β <o α ∧ p ∈ f β" unfolding 𝔏_def by blast
moreover then have "β ≤o α0 ∧ α0 ≤o α0" using c1 unfolding sc_ord_def
using not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
moreover then have "f ∈ 𝒩1 r α0" using a0 a1 lem_Shinf_N1[of f F] ordLeq_Well_order_simp by metis
ultimately show "p ∈ f α0" unfolding 𝒩1_def by blast
qed
moreover have "f α0 ⊆ 𝔏 f α" using c1 unfolding sc_ord_def 𝔏_def by blast
ultimately have "𝔏 f α = f α0" by blast
then have "𝔏 f α' = f α0" using e1 lem_shrel_L_eq by blast
then show "Field r ⊆ dncl r (f α')" using d2 e2 e1 b5 by force
qed
ultimately show "Field r ⊆ dncl r (f α')" using d2 by blast
qed
then show "f ∈ 𝒩10 r α" unfolding 𝒩10_def 𝒬_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩10 r β) ⟶ f ∈ 𝒩10 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩10 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ⟶
((∃y. (f α') - dncl r (𝔏 f α') = {y}) ⟶ (Field r ⊆ dncl r (f α')))"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α" and d2: "∃y. (f α') - dncl r (𝔏 f α') = {y}"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ (Field r ⊆ dncl r (f α'))"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "Field r ⊆ dncl r (f α')" using c1 d1 d2 unfolding 𝒩10_def 𝒬_def by blast
qed
moreover have "α' =o α ⟶ False"
proof
assume e1: "α' =o α"
moreover then have e2: "𝔏 f α' = 𝔏 f α" using lem_shrel_L_eq by blast
ultimately have "∃y. (f α) - dncl r (𝔏 f α) = {y}" using d2 b5 by metis
moreover have "f α ⊆ 𝔏 f α" using c2 unfolding 𝔏_def by blast
ultimately show "False" unfolding dncl_def by blast
qed
ultimately show "Field r ⊆ dncl r (f α')" using d2 by blast
qed
then show "f ∈ 𝒩10 r α" unfolding 𝒩10_def 𝒬_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩10 r α"] by blast
qed
lemma lem_Shinf_N11:
fixes r::"'U rel" and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀ α A. Well_order α ⟶ A ⊆ F α A"
and a5: "∀α. Well_order α ⟶ f ∈ 𝒩5 r α"
and a10: "∀ α A. Well_order α ⟶ A ∈ SF r ⟶
((∃y. (F α A) - dncl r A ⊆ {y}) ⟶ (Field r ⊆ dncl r (F α A)))"
shows "∀α. Well_order α ⟶ f ∈ 𝒩11 r α"
proof -
have b2: "f {} = {}"
and b3: "∀ α0 α::'U rel. (sc_ord α0 α ⟶ f α = F α0 (f α0))"
and b4: "∀ α. (lm_ord α ⟶ f α = ⋃ { D. ∃ β. β <o α ∧ D = f β })"
and b5: "∀α β. α =o β ⟶ f α = f β" using a0 unfolding 𝒯_def by blast+
have "¬ isSuccOrd ({}::'U rel)"
using wo_rel_def wo_rel.isSuccOrd_def unfolding Field_def by force
then have "f ∈ 𝒩11 r {}" using lem_ord_subemp unfolding 𝒩11_def by blast
moreover have "∀α0 α. sc_ord α0 α ∧ f ∈ 𝒩11 r α0 ⟶ f ∈ 𝒩11 r α"
proof (intro allI impI)
fix α0 α::"'U rel"
assume c1: "sc_ord α0 α ∧ f ∈ 𝒩11 r α0"
have "∀α'::'U rel. α' ≤o α ∧ (isSuccOrd α') ⟶
(( (f α') - dncl r (𝔏 f α') = {}) ⟶ (Field r ⊆ dncl r (f α')))"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (isSuccOrd α')"
and d2: "(f α') - dncl r (𝔏 f α') = {}"
then have "α0 <o α' ∨ α' ≤o α0" using c1 unfolding sc_ord_def
using not_ordLeq_iff_ordLess ordLeq_Well_order_simp ordLess_Well_order_simp by blast
moreover have "α' ≤o α0 ⟶ (((f α') - dncl r (𝔏 f α') = {}) ⟶ (Field r ⊆ dncl r (f α')))"
using d1 c1 unfolding 𝒩11_def 𝒬_def by blast
moreover have "α0 <o α' ⟶ α =o α'" using d1 c1 unfolding sc_ord_def using ordIso_iff_ordLeq by blast
moreover have "α =o α' ⟶ (Field r ⊆ dncl r (f α'))"
proof
assume e1: "α =o α'"
have "Well_order α0" using c1 unfolding sc_ord_def ordLess_def by blast
moreover then have "(f α0) ∈ SF r"
using a5 unfolding 𝒩5_def using ordLeq_reflexive by blast
moreover have "f α = F α0 (f α0)" using c1 b3 by blast
ultimately have e2: "(((f α) - dncl r (f α0) = {}) ⟶ (Field r ⊆ dncl r (f α)))"
using a10 by fastforce
have "𝔏 f α ⊆ f α0"
proof
fix p
assume "p ∈ 𝔏 f α"
then obtain β::"'U rel" where "β <o α ∧ p ∈ f β" unfolding 𝔏_def by blast
moreover then have "β ≤o α0 ∧ α0 ≤o α0" using c1 unfolding sc_ord_def
using not_ordLess_iff_ordLeq ordLess_Well_order_simp by blast
moreover then have "f ∈ 𝒩1 r α0" using a0 a1 lem_Shinf_N1[of f F] ordLeq_Well_order_simp by metis
ultimately show "p ∈ f α0" unfolding 𝒩1_def by blast
qed
moreover have "f α0 ⊆ 𝔏 f α" using c1 unfolding sc_ord_def 𝔏_def by blast
ultimately have "𝔏 f α = f α0" by blast
then have "𝔏 f α' = f α0" using e1 lem_shrel_L_eq by blast
then show "Field r ⊆ dncl r (f α')" using d2 e2 e1 b5 by force
qed
ultimately show "Field r ⊆ dncl r (f α')" using d2 by blast
qed
then show "f ∈ 𝒩11 r α" unfolding 𝒩11_def 𝒬_def by blast
qed
moreover have " ∀α. lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩11 r β) ⟶ f ∈ 𝒩11 r α"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "lm_ord α ∧ (∀β. β <o α ⟶ f ∈ 𝒩11 r β)"
then have c2: "f α = ⋃ { D. ∃ β. β <o α ∧ D = f β }" using b4 by blast
have "∀α'::'U rel. α' ≤o α ∧ (isSuccOrd α') ⟶
(((f α') - dncl r (𝔏 f α') = {}) ⟶ (Field r ⊆ dncl r (f α')))"
proof (intro allI impI)
fix α'::"'U rel"
assume d1: "α' ≤o α ∧ (isSuccOrd α')"
and d2: "(f α') - dncl r (𝔏 f α') = {}"
then have "α' <o α ∨ α' =o α" using ordLeq_iff_ordLess_or_ordIso by blast
moreover have "α' <o α ⟶ (Field r ⊆ dncl r (f α'))"
proof
assume "α' <o α"
moreover then have "α' ≤o α'" using ordLess_Well_order_simp ordLeq_reflexive by blast
ultimately show "Field r ⊆ dncl r (f α')" using c1 d1 d2 unfolding 𝒩11_def 𝒬_def by blast qed
moreover have "α' =o α ⟶ False"
proof
assume "α' =o α"
moreover then have "α' = {} ∨ isSuccOrd α" using d1 lem_osucc_eq by blast
moreover have "¬ (α = {} ∨ isSuccOrd α)" using c1 unfolding lm_ord_def by blast
ultimately have "α' =o α ∧ α' = {} ∧ α ≠ {}" by blast
then show "False" by (metis iso_ozero_empty ordIso_symmetric ozero_def)
qed
ultimately show "Field r ⊆ dncl r (f α')" using d2 by blast
qed
then show "f ∈ 𝒩11 r α" unfolding 𝒩11_def 𝒬_def by blast
qed
ultimately show ?thesis using lem_sclm_ordind[of "λ α. f ∈ 𝒩11 r α"] by blast
qed
lemma lem_Shinf_N12:
fixes r::"'U rel" and g::"'U rel ⇒ 'U"
and F::"'U rel ⇒ 'U set ⇒ 'U set" and f::"'U rel ⇒ 'U set"
assumes a0: "f ∈ 𝒯 F"
and a1: "∀α. Well_order α ⟶ f ∈ 𝒩1 r α"
and a2: "∀ α A. Well_order α ⟶ g α ∈ Field r ⟶ g α ∈ F α A"
and a11: "ω_ord ≤o |Field r| ⟶ Field r = g ` { γ::'U rel. γ <o |Field r| }"
and a2': "∀α::'U rel. ω_ord ≤o α ∧ α ≤o |Field r| ⟶ ω_ord ≤o |g ` {γ. γ <o α}|"
shows "f ∈ 𝒩12 r |Field r|"
proof -
have b1: "∀α. ω_ord =o α ∧ α ≤o |Field r| ⟶ ω_ord ≤o |𝔏 f α|"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "ω_ord =o α ∧ α ≤o |Field r|"
then have c2: "ω_ord ≤o |g`{γ. γ <o α}|" using a2' ordIso_imp_ordLeq by blast
have "g`{γ. γ <o α} ⊆ g`{γ. γ <o |Field r|}" using c1 ordLess_ordLeq_trans by force
then have "g`{γ. γ <o α} ⊆ Field r"
using c1 a11 ordLeq_transitive ordIso_imp_ordLeq[of ω_ord] by metis
have "g`{γ. γ <o α} ⊆ 𝔏 f α"
proof
fix a
assume "a ∈ g`{γ. γ <o α}"
then obtain γ where d1: "a = g γ ∧ γ <o α" by blast
obtain γ' where d2: "sc_ord γ γ'" using d1 lem_sucord_ex by blast
then have "f γ' = F γ (f γ)" using a0 unfolding 𝒯_def by blast
moreover have "Well_order γ" using d2 unfolding sc_ord_def using ordLess_def by blast
moreover have "g γ ∈ Field r" using d1 c1 a11 ordIso_ordLeq_trans ordLess_ordLeq_trans by blast
ultimately have "a ∈ f γ'" using d1 a2 by blast
moreover have "γ' <o α"
proof -
have "isLimOrd ω_ord" by (simp add: Field_natLeq card_order_infinite_isLimOrd natLeq_card_order)
then have "¬ isSuccOrd α"
using c1 lem_osucc_eq ordIso_symmetric
using natLeq_Well_order wo_rel.isLimOrd_def wo_rel_def by blast
then obtain β::"'U rel" where "γ <o β ∧ ¬ (α ≤o β)" using d1 lem_ordint_sucord by blast
then have "γ <o β ∧ β <o α" using d1
by (metis ordIso_imp_ordLeq ordLess_Well_order_simp ordLess_imp_ordLeq ordLess_or_ordIso)
then show "γ' <o α" using d2 unfolding sc_ord_def using ordLeq_ordLess_trans by blast
qed
ultimately show "a ∈ 𝔏 f α" unfolding 𝔏_def by blast
qed
then have "|g`{γ. γ <o α}| ≤o |𝔏 f α|" by simp
then show "ω_ord ≤o |𝔏 f α|" using c2 ordLeq_transitive by blast
qed
have "∀α. ω_ord ≤o α ∧ α ≤o |Field r| ⟶ ω_ord ≤o |𝔏 f α|"
proof (intro allI impI)
fix α::"'U rel"
assume "ω_ord ≤o α ∧ α ≤o |Field r|"
moreover then obtain α0::"'U rel" where d1: "ω_ord =o α0 ∧ α0 ≤o α"
using internalize_ordLeq[of ω_ord α] by blast
ultimately have "ω_ord =o α0 ∧ α0 ≤o |Field r|" using ordLeq_transitive by blast
then have "ω_ord ≤o |𝔏 f α0|" using b1 by blast
moreover have "𝔏 f α0 ⊆ 𝔏 f α" using d1 unfolding 𝔏_def using ordLess_ordLeq_trans by blast
moreover then have "|𝔏 f α0| ≤o |𝔏 f α|" by simp
ultimately show "ω_ord ≤o |𝔏 f α|" using ordLeq_transitive by blast
qed
then show ?thesis unfolding 𝒩12_def by blast
qed
lemma lem_Shinf_E_ne:
fixes r::"'U rel" and a0::"'U" and A::"'U set" and Ps::"'U set set"
assumes a2: "CCR r" and a3: "Ps ⊆ SCF r"
shows "ℰ r a0 A Ps ≠ {}"
proof (cases "A ∈ SF r")
assume b0: "A ∈ SF r"
show "ℰ r a0 A Ps ≠ {}"
proof (cases "finite A")
assume b1: "finite A"
then obtain A' where "(a0 ∈ Field r ⟶ a0 ∈ A')" and b2: "A ⊆ A'" and b3: "CCR (Restr r A') ∧ finite A'"
and "(∀a∈A. r``{a}⊆w_dncl r A ∨ r``{a}∩(A'-w_dncl r A) ≠ {})"
and "A' ∈ SF r" and b4: "(∃y. A' - dncl r A ⊆ {y}) ⟶ Field r ⊆ A' ∪ dncl r A"
and b5: "(∃ P. Ps = {P}) ⟶ (∀ P ∈ Ps. (A' ∩ P ∈ SCF (Restr r A')))"
using b0 a2 a3
lem_Ccext_finsubccr_pext5_scf3[of r A Ps a0 "w_dncl r A" "dncl r A"]
by metis
moreover have "|A'| <o ω_ord" using b3 finite_iff_ordLess_natLeq by blast
moreover have "¬ ( ω_ord ≤o |A| )" using b1 infinite_iff_natLeq_ordLeq by blast
moreover have "(∃y. A' - dncl r A ⊆ {y}) ⟶ Field r ⊆ dncl r A' " using b2 b4 unfolding dncl_def by blast
moreover have "(∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| ) ⟶ (∃ P. Ps = {P})"
using b1 card_of_ordLeq_finite by blast
ultimately have "A' ∈ ℰ r a0 A Ps" unfolding ℰ_def ℰp_def by fast
then show ?thesis by blast
next
assume b1: "¬ finite A"
then obtain A' where b2: "(a0 ∈ Field r ⟶ a0 ∈ A')" and b3: "A ⊆ A'" and b4: "CCR (Restr r A')"
and b5: "|A'| =o |A|" and b6: "(∀a∈A. r``{a}⊆w_dncl r A ∨ r``{a}∩(A'-w_dncl r A) ≠ {})"
and b7: "A' ∈ SF r" and b8: "(∃y. A' - dncl r A ⊆ {y}) ⟶ Field r ⊆ A' ∪ dncl r A"
and b9: "( |Ps| ≤o |A| ⟶ (∀ P ∈ Ps. (A' ∩ P) ∈ SCF (Restr r A')) )"
and b10: "escl r A A' ⊆ A'" and b11: "clterm (Restr r A') r"
using b0 a2 a3
lem_Ccext_infsubccr_pext5_scf3[of r A Ps a0 "w_dncl r A" "dncl r A"] by metis
then have "(ω_ord ≤o |A| ⟶ |A'| ≤o |A| )" using ordIso_iff_ordLeq by blast
moreover have "( |A| <o ω_ord ⟶ |A'| <o ω_ord)" using b1 finite_iff_ordLess_natLeq by blast
moreover have "(∃y. A' - dncl r A ⊆ {y}) ⟶ (Field r ⊆ dncl r A')" using b3 b8 unfolding dncl_def by blast
moreover have "(∃ P. Ps = {P}) ∨ ((¬ finite Ps) ∧ |Ps| ≤o |A| ) ⟶ |Ps| ≤o |A|"
using b1 by (metis card_of_singl_ordLeq finite.simps)
ultimately have "A' ∈ ℰ r a0 A Ps" unfolding ℰ_def ℰp_def
using b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 by fast
then show ?thesis by blast
qed
next
assume "A ∉ SF r"
moreover obtain A' where b1: "A' = A ∪ {a0}" by blast
moreover then have "|A| <o ω_ord ⟶ |A'| <o ω_ord" using finite_iff_ordLess_natLeq by blast
moreover have "ω_ord ≤o |A| ⟶ |A'| ≤o |A|"
proof
assume "ω_ord ≤o |A|"
then have "¬ finite A" using finite_iff_ordLess_natLeq not_ordLeq_ordLess by blast
then have "|A'| =o |A|" unfolding b1 using infinite_card_of_insert by simp
then show "|A'| ≤o |A|" using ordIso_imp_ordLeq by blast
qed
ultimately have "A' ∈ ℰ r a0 A Ps" unfolding ℰ_def by blast
then show "ℰ r a0 A Ps ≠ {}" by blast
qed
lemma lem_oseq_fin_inj:
fixes g::"'U rel ⇒ 'a" and I::"'U rel ⇒ 'U rel set" and A::"'a set"
assumes a1: "I = (λ α'. { α::'U rel. α <o α' })"
and a2: "ω_ord ≤o |A|"
and a3: "∀ α β. α =o β ⟶ g α = g β"
shows "∃ h. (∀ α'. g`(I α') ⊆ h`(I α') ∧ h`(I α') ⊆ g`(I α') ∪ A)
∧ (∀ α'. ω_ord ≤o α' ⟶ ω_ord ≤o |h`(I α')| )
∧ (∀ α β. α =o β ⟶ h α = h β)"
proof(cases "∃ α::'U rel. ω_ord ≤o α")
assume "∃ α::'U rel. ω_ord ≤o α"
then obtain αm::"'U rel" where b1: "ω_ord =o αm" by (metis internalize_ordLeq)
obtain f::"nat ⇒ 'U rel" where b2: "f = (λ n. SOME α. α =o (natLeq_on n))" by blast
have "|UNIV::nat set| ≤o |A|" using a2 using card_of_nat ordIso_imp_ordLeq ordLeq_transitive by blast
then obtain xi::"nat ⇒ 'a" where b3: "inj xi ∧ xi ` UNIV ⊆ A" by (meson card_of_ordLeq)
obtain yi where b4: "yi = (λ n. if (∃ i<n. g (f n) = g (f i)) then (xi n) else (g (f n)))" by blast
obtain h where b5: "h = (λ α. if (∃ n. α =o f n) then (yi (SOME n. (α =o f n))) else (g α))" by blast
have b6: "⋀ n::nat. f n =o (natLeq_on n)"
proof -
fix n
have "natLeq_on n <o αm" using b1 natLeq_on_ordLess_natLeq ordLess_ordIso_trans by blast
then obtain α::"'U rel" where "α =o (natLeq_on n)"
using internalize_ordLess ordIso_symmetric by fastforce
then show "f n =o natLeq_on n" using b2 someI_ex[of "λα::'U rel. α =o (natLeq_on n)"] by blast
qed
then have b7: "⋀ n m. n ≤ m ⟹ f n ≤o f m"
by (metis (no_types, lifting) natLeq_on_ordLeq_less_eq ordIso_imp_ordLeq ordIso_symmetric ordLeq_transitive)
have b8: "⋀ n m. f n =o f m ⟹ n = m"
proof -
fix n m
assume "f n =o f m"
moreover then have "natLeq_on n =o f m" using b6 ordIso_transitive ordIso_symmetric by blast
ultimately have "natLeq_on n =o natLeq_on m" using b6 ordIso_transitive by blast
then show "n = m" using natLeq_on_injective_ordIso by blast
qed
have b9: "⋀ α n. α =o f n ⟹ h α = yi n"
proof -
fix α::"'U rel" and n::nat
assume "α =o f n"
moreover obtain m where "m = (SOME n. (α =o f n))" by blast
ultimately have "h α = yi m ∧ α =o f m ∧ α =o f n" using b5 someI_ex[of "λ n. α =o f n"] by fastforce
moreover then have "m = n" using b8 ordIso_transitive ordIso_symmetric by blast
ultimately show "h α = yi n" by blast
qed
have b10: "⋀ n. yi`{k. k ≤ n} ⊆ g`(f`({k. k ≤ n})) ∪ A"
proof -
fix n0
show "yi`{k. k ≤ n0} ⊆ g`(f`({k. k ≤ n0})) ∪ A"
proof (induct n0)
show "yi`{k. k ≤ 0} ⊆ g`(f`{k. k ≤ 0}) ∪ A" using b4 by simp
next
fix n
assume d1: "yi`{k. k ≤ n} ⊆ g`(f`({k. k ≤ n})) ∪ A"
show "yi`{k. k ≤ Suc n} ⊆ g`(f`({k. k ≤ (Suc n)})) ∪ A"
proof (cases "∃ i<Suc n. g (f (Suc n)) = g (f i)")
assume "∃ i<Suc n. g (f (Suc n)) = g (f i)"
then obtain i where "i<Suc n ∧ g (f (Suc n)) = g (f i)" by blast
then have "i ≤ n ∧ yi (Suc n) = xi (Suc n)" using b4 by force
then have "yi (Suc n) ∈ g`(f`({k. k ≤ Suc n})) ∪ A" using b3 by blast
moreover have "yi`{k. k ≤ n} ⊆ g`(f`({k. k ≤ Suc n})) ∪ A" using d1 by fastforce
moreover have "⋀ k. k ≤ Suc n ⟷ (k ≤n ∨ k = Suc n)" by linarith
moreover then have "yi`{k. k ≤ Suc n} = yi`{k. k ≤ n} ∪ {yi (Suc n)}" by fastforce
ultimately show ?thesis by blast
next
assume "¬ (∃ i<Suc n. g (f (Suc n)) = g (f i))"
then have "yi (Suc n) = g (f (Suc n))" using b4 by force
then have "yi (Suc n) ∈ g`(f`({k. k ≤ Suc n})) ∪ A" by blast
moreover have "yi`{k. k ≤ n} ⊆ g`(f`({k. k ≤ Suc n})) ∪ A" using d1 by fastforce
moreover have "⋀ k. k ≤ Suc n ⟷ (k ≤n ∨ k = Suc n)" by linarith
moreover then have "yi`{k. k ≤ Suc n} = yi`{k. k ≤ n} ∪ {yi (Suc n)}" by fastforce
ultimately show ?thesis by blast
qed
qed
qed
have "∀ α'. g`(I α') ⊆ h`(I α') ∧ h`(I α') ⊆ g`(I α') ∪ A"
proof
fix α'::"'U rel"
have "g`(I α') ⊆ h`(I α')"
proof
fix a
assume "a ∈ g`(I α')"
then obtain β where d1: "β <o α' ∧ a = g β" using a1 by blast
show "a ∈ h`(I α')"
proof (cases "∃ n. β =o f n")
assume "∃ n. β =o f n"
then obtain n where e1: "β =o f n" by blast
then have e2: "a = g (f n) ∧ h β = yi n" using d1 b9 a3 by blast
obtain P where e3: "P = (λ i. i≤n ∧ g (f n) = g (f i))" by blast
obtain k where "k = (LEAST i. P i)" by blast
moreover have "P n" using e3 by blast
ultimately have "P k ∧ (∀ i. P i ⟶ k ≤ i)" using LeastI Least_le by metis
then have "k ≤ n ∧ g (f n) = g (f k) ∧ ¬ (∃ i<k. g (f k) = g (f i))"
using e3 by (metis leD less_le_trans less_or_eq_imp_le)
then have "a = yi k ∧ f k ≤o f n" using e2 b4 b7 by fastforce
moreover then have "f k <o α'"
using e1 d1 by (metis ordIso_symmetric ordLeq_ordIso_trans ordLeq_ordLess_trans)
ultimately have "f k ∈ I α' ∧ h (f k) = a" using a1 b7 b9 ordIso_iff_ordLeq by blast
then show ?thesis by blast
next
assume "¬ (∃ n. β =o f n)"
then have "h β = g β" using b5 by simp
then show ?thesis using d1 a1 by force
qed
qed
moreover have "h`(I α') ⊆ g`(I α') ∪ A"
proof
fix a
assume "a ∈ h`(I α')"
then obtain β where d1: "β <o α' ∧ a = h β" using a1 by blast
show "a ∈ g`(I α') ∪ A"
proof (cases "∃ n. β =o f n")
assume "∃ n. β =o f n"
then obtain n where e1: "β =o f n" by blast
then have "a = yi n" using d1 b9 by blast
then have "a ∈ g`(f`({k. k ≤ n})) ∪ A" using b10 by blast
moreover have "∀ k. k ≤ n ⟶ f k ∈ I α'"
proof (intro allI impI)
fix k
assume "k ≤ n"
then have "f k ≤o f n" using b7 by blast
then show "f k ∈ I α'" using e1 a1 d1
using ordIso_symmetric ordLeq_ordIso_trans ordLeq_ordLess_trans by fastforce
qed
ultimately show ?thesis by blast
next
assume "¬ (∃ n. β =o f n)"
then show ?thesis using d1 a1 b5 by force
qed
qed
ultimately show "g`(I α') ⊆ h`(I α') ∧ h`(I α') ⊆ g`(I α') ∪ A" by blast
qed
moreover have "∀ α'. ω_ord ≤o α' ⟶ ω_ord ≤o |h`(I α')|"
proof (intro allI impI)
fix α'::"'U rel"
assume "ω_ord ≤o α'"
then have "I αm ⊆ I α'"
using a1 b1 by (smt mem_Collect_eq not_ordLess_ordIso ordIso_symmetric
ordLeq_iff_ordLess_or_ordIso ordLeq_ordLess_trans ordLeq_transitive subsetI)
moreover have "f`UNIV ⊆ I αm" using b1 a1
using b6 natLeq_on_ordLess_natLeq ordIso_ordLess_trans ordLess_ordIso_trans by fastforce
ultimately have "h`(f`UNIV) ⊆ h`(I α')" by blast
then have "|h`(f`UNIV)| ≤o |h`(I α')|" by simp
moreover have "ω_ord ≤o |h`(f`UNIV)|"
proof -
have "∀ n. h (f n) = yi n" using b7 b9 ordIso_iff_ordLeq by blast
then have "yi`UNIV ⊆ h`(f`UNIV)" by (smt imageE image_eqI subset_eq)
then have "|yi`UNIV| ≤o |h`(f`UNIV)|" by simp
moreover have "ω_ord ≤o |yi`UNIV|"
proof (cases "finite (g`(f`UNIV))")
assume e1: "finite(g`(f`UNIV))"
obtain J where e3: "J = {n. ∃i<n. g (f n) = g (f i)}" by blast
have "(∀ m. ∃ n>m. n ∉ J) ⟶ False"
proof
assume f1: "∀ m. ∃ n>m. n ∉ J"
obtain w where f2: "w = (λ m. SOME n. n>m ∧ n ∉ J)" by blast
have f3: "∀ m. w m > m ∧ w m ∉ J"
proof
fix m
show "w m > m ∧ w m ∉ J" using f1 f2 someI_ex[of "λ n. n>m ∧ n ∉ J"] by metis
qed
obtain p where f4: "p = (λ k::nat. (w^^k) 0)" by blast
have f5: "∀ k. k ≠ 0 ⟶ p k ∉ J"
proof
fix k
show "k ≠ 0 ⟶ p k ∉ J"
proof (induct k)
show "0 ≠ 0 ⟶ p 0 ∉ J" by blast
next
fix k
assume "k ≠ 0 ⟶ p k ∉ J"
show "Suc k ≠ 0 ⟶ p (Suc k) ∉ J" using f3 f4 by simp
qed
qed
have "∀ j. ∀ i<j. p i < p j"
proof
fix j
show "∀i<j. p i < p j"
proof (induct j)
show "∀i<0. p i < p 0" by blast
next
fix j
assume "∀i<j. p i < p j"
moreover have "p j < p (Suc j)" using f3 f4 by force
ultimately show "∀i<Suc j. p i < p (Suc j)" by (metis less_antisym less_trans)
qed
qed
then have "inj p" unfolding inj_on_def by (metis nat_neq_iff)
then have "¬ finite (p`UNIV)" using finite_imageD by blast
moreover obtain P where f6: "P = p`{k. k ≠ 0}" by blast
moreover have "UNIV = {0} ∪ {k::nat. k ≠ 0}" by blast
moreover then have "p`UNIV = p`{0} ∪ P ∧ finite (p`{0})" using f6 by fastforce
ultimately have f7: "¬ finite P" using finite_UnI by metis
have "∀ n ∈ P. ∀ m ∈ P. g (f n) = g (f m) ⟶ n = m"
proof (intro ballI impI)
fix n m
assume g1: "n ∈ P" and g2: "m ∈ P" and g3: "g (f n) = g (f m)"
have "n < m ⟶ False"
proof
assume "n < m"
moreover then have "m ∉ J" using g2 f5 f6 by blast
ultimately show "False" using g3 e3 by force
qed
moreover have "m < n ⟶ False"
proof
assume "m < n"
moreover then have "n ∉ J" using g1 f5 f6 by blast
ultimately show "False" using g3 e3 by force
qed
ultimately show "n = m" by force
qed
then have "inj_on (g ∘ f) P" unfolding inj_on_def by simp
then have "¬ finite ((g ∘ f)`UNIV)" using f7
by (metis finite_imageD infinite_iff_countable_subset subset_UNIV subset_image_iff)
moreover have "(g ∘ f)`UNIV = g`(f`UNIV)" by force
ultimately show "False" using e1 by simp
qed
then obtain m where "∀ n>m. n ∈ J" by blast
then have "∀ n>m. yi n = xi n" using e3 b4 by force
then have e4: "xi`{n. n>m} ⊆ yi`UNIV" by (metis image_Collect_subsetI rangeI)
have e5: "|xi`{n. n>m}| =o |{n. n>m}|" using b3 by (metis card_of_image image_inv_f_f ordIso_iff_ordLeq)
have "finite {n. n≤m} ∧ (¬ finite (UNIV::nat set)) ∧ {n. n≤m} ∪ {n. n>m} = UNIV" by force
then have "¬ finite {n. n>m}" using finite_UnI by metis
then have "|xi`{n. n>m}| =o ω_ord" using e5 by (meson card_of_UNIV card_of_nat
finite_iff_cardOf_nat ordIso_transitive ordLeq_iff_ordLess_or_ordIso)
then show ?thesis using e4
by (metis finite_subset infinite_iff_natLeq_ordLeq ordIso_natLeq_infinite1)
next
assume "¬ finite (g`(f`UNIV))"
moreover have "g`(f`UNIV) ⊆ yi`UNIV"
proof
fix a
assume "a ∈ g`(f`UNIV)"
then obtain n where e1: "a = g (f n)" by blast
obtain P where e3: "P = (λ i. i≤n ∧ g (f n) = g (f i))" by blast
obtain k where "k = (LEAST i. P i)" by blast
moreover have "P n" using e3 by blast
ultimately have "P k ∧ (∀ i. P i ⟶ k ≤ i)" using LeastI Least_le by metis
then have "g (f n) = g (f k) ∧ ¬ (∃ i<k. g (f k) = g (f i))"
using e3 by (metis leD less_le_trans less_or_eq_imp_le)
then have "yi k = a" using e1 b4 b7 by fastforce
then show "a ∈ yi`UNIV" by blast
qed
ultimately have "¬ finite (yi`UNIV)" using finite_subset by metis
then show ?thesis using infinite_iff_natLeq_ordLeq by blast
qed
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately show "ω_ord ≤o |h`(I α')|" using ordLeq_transitive by blast
qed
moreover have "∀ α β. α =o β ⟶ h α = h β"
proof (intro allI impI)
fix α::"'U rel" and β::"'U rel"
assume c1: "α =o β"
show "h α = h β"
proof (cases "∃ n. α =o f n")
assume "∃ n. α =o f n"
moreover then have "∃ n. β =o f n" using c1 ordIso_transitive ordIso_symmetric by metis
moreover have "∀ n. (α =o f n) = (β =o f n)" using c1 ordIso_transitive ordIso_symmetric by metis
ultimately show "h α = h β" using b5 by simp
next
assume "¬ (∃ n. α =o f n)"
moreover then have "¬ (∃ n. β =o f n)" using c1 ordIso_transitive by metis
ultimately show "h α = h β" using b5 c1 a3 by simp
qed
qed
ultimately show ?thesis by blast
next
assume "¬ (∃ α::'U rel. ω_ord ≤o α)"
then show ?thesis using a3 by blast
qed
lemma lem_Shinf_N_ne:
fixes r::"'U rel" and Ps::"'U set set"
assumes "CCR r" and "Ps ⊆ SCF r"
shows "𝒩 r Ps ≠ {}"
proof -
obtain E :: "'U ⇒ 'U set ⇒ 'U set" where "E = (λ a A. SOME A'. A' ∈ ℰ r a A Ps)" by blast
moreover have "∀ a A. ∃ A'. A' ∈ ℰ r a A Ps" using assms lem_Shinf_E_ne[of r Ps] by blast
ultimately have b1: "∀ a A. E a A ∈ ℰ r a A Ps" by (meson someI_ex)
have "∃ g::'U rel ⇒ 'U. (ω_ord ≤o |Field r| ⟶ Field r = g ` {γ. γ <o |Field r|}) ∧
(∀α'::'U rel. ω_ord ≤o α' ∧ α' ≤o |Field r| ⟶ ω_ord ≤o |g ` {γ. γ <o α'}| ) ∧
(∀α β. α =o β ⟶ g α = g β)"
proof(cases "ω_ord ≤o |Field r|")
assume c1: "ω_ord ≤o |Field r|"
moreover have "Card_order |Field r| ∧ |Field r| ≤o |Field r|" by simp
ultimately obtain g0::"'U rel ⇒ 'U" where
c2: "Field r ⊆ g0 ` {γ. γ <o |Field r| }"
and c3: "∀ α β. α =o β ⟶ g0 α = g0 β"
using c1 lem_card_setcv_inf_stab[of "|Field r|" "Field r"] by blast
have "Field r ≠ {}" using c1 by (metis finite.emptyI infinite_iff_natLeq_ordLeq)
then obtain a0 where "a0 ∈ Field r" by blast
moreover obtain t where "t = (λ a. if (a ∈ Field r) then a else a0)" by blast
moreover obtain g1 where "g1 = (λ α. t (g0 α))" by blast
ultimately have c4: "Field r ⊆ g1`{γ . γ <o |Field r| }"
and c5: "∀ α β. α =o β ⟶ g1 α = g1 β" and c6: "g1`UNIV ⊆ Field r" using c2 c3 by force+
obtain I where c7: "I = (λα'::'U rel. {α::'U rel. α <o α'})" by blast
then obtain g where c8: "(∀ α'. g1`(I α') ⊆ g`(I α') ∧ g`(I α') ⊆ g1`(I α') ∪ (Field r))"
and c9: "∀ α'. ω_ord ≤o α' ⟶ ω_ord ≤o |g`(I α')|"
and c10: "(∀ α β. α =o β ⟶ g α = g β)" using c1 c5 lem_oseq_fin_inj[of I "Field r" g1] by blast
have "g1`(I |Field r| ) ⊆ Field r" using c6 by blast
then have "g ` { γ. γ <o |Field r| } ⊆ Field r" using c7 c8 by blast
moreover have "Field r ⊆ g`{ γ. γ <o |Field r| }" using c4 c7 c8 by force
ultimately have "ω_ord ≤o |Field r| ⟶ Field r = g`{ γ. γ <o |Field r| }" by blast
then show ?thesis using c7 c9 c10 by blast
next
assume "¬ ω_ord ≤o |Field r|"
moreover then have "∀α'::'U rel. ¬ (ω_ord ≤o α' ∧ α' ≤o |Field r| )" using ordLeq_transitive by blast
moreover have "∃ g::'U rel ⇒ 'U. (∀ α β. α =o β ⟶ g α = g β)" by force
ultimately show ?thesis by blast
qed
then obtain g::"'U rel ⇒ 'U" where
b4: "ω_ord ≤o |Field r| ⟶ Field r = g ` { γ::'U rel. γ <o |Field r| }"
and b4': "∀α'::'U rel. ω_ord ≤o α' ∧ α' ≤o |Field r| ⟶ ω_ord ≤o |g ` {γ. γ <o α'}|"
and b5: "∀ α β. α =o β ⟶ g α = g β" by blast
obtain F::"'U rel ⇒ 'U set ⇒ 'U set" where b6: "F = (λ α A. E (g α) A)" by blast
then have "∀ α β. α =o β ⟶ F α = F β" using b5 by fastforce
then obtain f::"'U rel ⇒ 'U set" where b7: "f ∈ 𝒯 F"
unfolding 𝒯_def using lem_ordseq_rec_sets[of F "{}"] by clarsimp
have b8: "Well_order |Field r|" by simp
have "𝒩 r Ps ≠ {}"
proof -
have c0: "∀ α A. A ∈ SF r ⟶ F α A ∈ SF r" using b6 b1 unfolding ℰ_def by simp
have c1: "∀ α A. A ⊆ F α A" using b6 b1 unfolding ℰ_def by simp
have c2: "∀ α A. (g α ∈ Field r ⟶ g α ∈ F α A)" using b6 b1 unfolding ℰ_def by blast
have c3: "∀ α A. A ∈ SF r ⟶ ω_ord ≤o |A| ⟶ escl r A (F α A) ⊆ (F α A) ∧ clterm (Restr r (F α A)) r"
using b6 b1 unfolding ℰ_def by blast
have c4: "∀ α A. A ∈ SF r ⟶
( ∀ a∈A. r `` {a} ⊆ w_dncl r A ∨ r `` {a} ∩ (F α A - w_dncl r A) ≠ {} )"
using b6 b1 unfolding ℰ_def by blast
have c6: "∀ α A. A ∈ SF r ⟶ CCR (Restr r (F α A))"
using b6 b1 unfolding ℰ_def by blast
have c7: "∀ α A. ( |A| <o ω_ord ⟶ |F α A| <o ω_ord) ∧ ( ω_ord ≤o |A| ⟶ |F α A| ≤o |A| )"
using b6 b1 unfolding ℰ_def by blast
have c8: "∀ α A. A ∈ SF r ⟶ ℰp r Ps A (F α A)" using b6 b1 unfolding ℰ_def ℰp_def by blast
have c10: "∀ α A. A ∈ SF r ⟶ ((∃y. (F α A) - dncl r A ⊆ {y}) ⟶ (Field r ⊆ dncl r (F α A)))"
using b6 b1 unfolding ℰ_def by blast
have c1': "∀α. Well_order α ⟶ f ∈ 𝒩1 r α" using b7 b8 c1 lem_Shinf_N1[of f F r] by blast
have c5': "∀α. Well_order α ⟶ f ∈ 𝒩5 r α" using b7 b8 c0 lem_Shinf_N5[of f F r] by blast
have "f ∈ 𝒩1 r |Field r|" using b7 b8 c1 lem_Shinf_N1[of f F r] by blast
moreover have "f ∈ 𝒩2 r |Field r|" using b7 b8 lem_Shinf_N2[of f F r] by blast
moreover have "f ∈ 𝒩3 r |Field r|" using b7 b8 c1 c3 c5' lem_Shinf_N3[of f F r] by blast
moreover have "f ∈ 𝒩4 r |Field r|" using b7 b8 c1 c4 c5' lem_Shinf_N4[of f F r] by blast
moreover have "f ∈ 𝒩5 r |Field r|" using b7 b8 c0 lem_Shinf_N5[of f F r] by blast
moreover have "f ∈ 𝒩6 r |Field r|" using b7 b8 c1 c6 c5' lem_Shinf_N6[of f F r] by blast
moreover have "f ∈ 𝒩7 r |Field r|" using b7 b8 c1 c7 lem_Shinf_N7[of f F r] by blast
moreover have "f ∈ 𝒩8 r Ps |Field r|" using b7 b8 c1 c7 c8 c5' lem_Shinf_N8[of f F r Ps] by blast
moreover have "f ∈ 𝒩9 r |Field r|" using b7 b4 c1 c2 lem_Shinf_N9[of f F g r] by blast
moreover have "f ∈ 𝒩10 r |Field r|" using b7 b8 c1 c10 c5' lem_Shinf_N10[of f F r] by metis
moreover have "f ∈ 𝒩11 r |Field r|" using b7 b8 c1 c10 c5' lem_Shinf_N11[of f F r] by metis
moreover have "f ∈ 𝒩12 r |Field r|" using b7 c1' c2 b4 b4' lem_Shinf_N12[of f F r g] by blast
moreover have "∀ α β. α =o β ⟶ f α = f β" using b7 unfolding 𝒯_def by blast
ultimately show ?thesis unfolding 𝒩_def by blast
qed
then show ?thesis by blast
qed
lemma lem_wrankrel_eq: "wrank_rel r A0 α ⟹ α =o β ⟹ wrank_rel r A0 β"
proof -
assume a1: "wrank_rel r A0 α" and a2: "α =o β"
then obtain B where "B ∈ wbase r A0 ∧ |B| =o α ∧ ( ∀ B' ∈ wbase r A0. |B| ≤o |B'| )" unfolding wrank_rel_def by blast
moreover then have "|B| =o β" using a2 by (metis ordIso_transitive)
ultimately show "wrank_rel r A0 β" unfolding wrank_rel_def by blast
qed
lemma lem_wrank_wrankrel:
fixes r::"'U rel" and A0::"'U set"
shows "wrank_rel r A0 (wrank r A0)"
proof -
have b1: "wbase r A0 ≠ {}" using lem_wdn_range_lb[of A0 r] unfolding wbase_def by blast
obtain Q where b2: "Q = { α::'U rel. ∃ A ∈ wbase r A0. α =o |A| }" by blast
have b3: "∀ A ∈ wbase r A0. ∃ α ∈ Q. α ≤o |A|"
proof
fix A
assume "A ∈ wbase r A0"
then have "|A| ∈ Q ∧ |A| =o |A|" using b2 ordIso_symmetric by force
then show "∃ α ∈ Q. α ≤o |A|" using ordIso_iff_ordLeq by blast
qed
then have "Q ≠ {}" using b1 by blast
then obtain α where b4: "α ∈ Q ∧ (∀α'. α' <o α ⟶ α' ∉ Q)" using wf_ordLess wf_eq_minimal[of "ordLess"] by blast
moreover have "∀ α' ∈ Q. Card_order α'" using b2 using ordIso_card_of_imp_Card_order by blast
ultimately have "∀ α' ∈ Q. ¬ (α' <o α) ⟶ α ≤o α'" by simp
then have b5: "α ∈ Q ∧ (∀ α' ∈ Q. α ≤o α')" using b4 by blast
then obtain A where b6: "A ∈ wbase r A0 ∧ |A| =o α" using b2 ordIso_symmetric by blast
moreover have "∀ B∈wbase r A0. |A| ≤o |B|"
proof
fix B
assume "B ∈ wbase r A0"
then obtain α' where "α' ∈ Q ∧ α' ≤o |B|" using b3 by blast
moreover then have "|A| =o α ∧ α ≤o α'" using b5 b6 by blast
ultimately show "|A| ≤o |B|" using ordIso_ordLeq_trans ordLeq_transitive by blast
qed
ultimately have "wrank_rel r A0 α" unfolding wrank_rel_def by blast
then show ?thesis unfolding wrank_def by (metis someI2)
qed
lemma lem_wrank_uset:
fixes r::"'U rel" and A0::"'U set"
shows "∃ A ∈ wbase r A0. |A| =o wrank r A0 ∧ ( ∀ B ∈ wbase r A0. |A| ≤o |B| )"
using lem_wrank_wrankrel unfolding wrank_rel_def by blast
lemma lem_wrank_uset_mem_bnd:
fixes r::"'U rel" and A0 B::"'U set"
assumes "B ∈ wbase r A0"
shows "wrank r A0 ≤o |B|"
proof -
obtain A where "A ∈ wbase r A0 ∧ |A| =o wrank r A0 ∧ ( ∀ A' ∈ wbase r A0. |A| ≤o |A'| )" using assms lem_wrank_uset by blast
moreover then have "|A| ≤o |B|" using assms by blast
ultimately show ?thesis by (metis ordIso_iff_ordLeq ordLeq_transitive)
qed
lemma lem_wrank_cardord: "Card_order (wrank r A0)"
proof -
obtain A where "A ∈ wbase r A0 ∧ |A| =o wrank r A0" using lem_wrank_uset by blast
then show "Card_order (wrank r A0)" using Card_order_ordIso2 card_of_Card_order by blast
qed
lemma lem_wrank_ub: "wrank r A0 ≤o |A0|"
using lem_wdn_range_lb[of A0 r] lem_wrank_uset_mem_bnd unfolding wbase_def by blast
lemma lem_card_un2_bnd: "ω_ord ≤o α ⟹ |A| ≤o α ⟹ |B| ≤o α ⟹ |A ∪ B| ≤o α"
proof -
assume "ω_ord ≤o α" and "|A| ≤o α" and "|B| ≤o α"
moreover have "|{A, B}| ≤o ω_ord" using finite_iff_ordLess_natLeq ordLess_imp_ordLeq by blast
ultimately have "|⋃{A, B}| ≤o α" using lem_card_un_bnd[of "{A,B}"] ordLeq_transitive by blast
then show "|A ∪ B| ≤o α" by simp
qed
lemma lem_card_un2_lsbnd: "ω_ord ≤o α ⟹ |A| <o α ⟹ |B| <o α ⟹ |A ∪ B| <o α"
proof -
assume b1: "ω_ord ≤o α" and b2: "|A| <o α" and b3: "|B| <o α"
have "¬ finite A ⟶ |A ∪ B| <o α"
proof
assume c1: "¬ finite A"
show "|A ∪ B| <o α"
proof (cases "|A| ≤o |B|")
assume "|A| ≤o |B|"
then have "|A ∪ B| =o |B|" using c1 by (metis card_of_Un_infinite card_of_ordLeq_finite)
then show ?thesis using b3 by (metis ordIso_ordLess_trans)
next
assume "¬ |A| ≤o |B|"
then have "|B| ≤o |A|" by (metis card_of_Well_order ordLeq_total)
then have "|A ∪ B| =o |A|" using c1 by (metis card_of_Un_infinite)
then show ?thesis using b2 by (metis ordIso_ordLess_trans)
qed
qed
moreover have "¬ finite B ⟶ |A ∪ B| <o α"
proof
assume c1: "¬ finite B"
show "|A ∪ B| <o α"
proof (cases "|A| ≤o |B|")
assume "|A| ≤o |B|"
then have "|A ∪ B| =o |B|" using c1 by (metis card_of_Un_infinite)
then show ?thesis using b3 by (metis ordIso_ordLess_trans)
next
assume "¬ |A| ≤o |B|"
then have "|B| ≤o |A|" by (metis card_of_Well_order ordLeq_total)
then have "|A ∪ B| =o |A|" using c1 by (metis card_of_Un_infinite card_of_ordLeq_finite)
then show ?thesis using b2 by (metis ordIso_ordLess_trans)
qed
qed
moreover have "finite A ∧ finite B ⟶ |A ∪ B| <o α"
proof
assume "finite A ∧ finite B"
then have "finite (A ∪ B)" by blast
then show "|A ∪ B| <o α" using b1
by (meson card_of_nat finite_iff_cardOf_nat ordIso_imp_ordLeq ordLess_ordLeq_trans)
qed
ultimately show ?thesis by blast
qed
lemma lem_wrank_un_bnd:
fixes r::"'U rel" and S::"'U set set" and α::"'U rel"
assumes a1: "∀ A∈S. wrank r A ≤o α" and a2: "|S| ≤o α" and a3: "ω_ord ≤o α"
shows "wrank r (⋃ S) ≤o α"
proof -
obtain h where b1: "h = (λ A B. B ∈ wbase r A ∧ |B| =o wrank r A)" by blast
obtain Bi where b2: "Bi = (λ A. SOME B. h A B)" by blast
have "∀A∈S. ∃ B. h A B" using b1 lem_wrank_uset[of r] by blast
then have "∀A∈S. h A (Bi A)" using b2 by (metis someI_ex)
then have b3: "∀A∈S. (Bi A) ∈ wbase r A ∧ |Bi A| =o wrank r A" using b1 by blast
then have b4: "∀ A ∈ S. |Bi A| ≤o α" using assms ordIso_ordLeq_trans by blast
obtain S' where b5: "S' = Bi ` S" by blast
then have "|S'| ≤o |S| ∧ (∀ X ∈ S'. |X| ≤o α)" using b4 by simp
moreover then have "|S'| ≤o α" using a2 by (metis ordLeq_transitive)
ultimately have "|⋃S'| ≤o α" using a3 lem_card_un_bnd[of S' α] by blast
moreover obtain B where b6: "B = (⋃A∈S. Bi A)" by blast
ultimately have b7: "|B| ≤o α" using b5 by simp
have "∀A∈S. A ⊆ w_dncl r (Bi A)" using b3 unfolding wbase_def by blast
then have "⋃S ⊆ w_dncl r B" using b6 lem_wdn_mon[of _ B r] by blast
then have "B ∈ wbase r (⋃S)" unfolding wbase_def by blast
then have "wrank r (⋃S) ≤o |B|" using lem_wrank_uset_mem_bnd by blast
then show ?thesis using b7 by (metis ordLeq_transitive)
qed
lemma lem_wrank_un_bnd_stab:
fixes r::"'U rel" and S::"'U set set" and α::"'U rel"
assumes a1: "∀ A∈S. wrank r A <o α" and a2: "|S| <o α" and a3: "stable α"
shows "wrank r (⋃ S) <o α"
proof -
obtain h where b1: "h = (λ A B. B ∈ wbase r A ∧ |B| =o wrank r A)" by blast
obtain Bi where b2: "Bi = (λ A. SOME B. h A B)" by blast
have "∀A∈S. ∃ B. h A B" using b1 lem_wrank_uset[of r] by blast
then have "∀A∈S. h A (Bi A)" using b2 by (metis someI_ex)
then have b3: "∀A∈S. (Bi A) ∈ wbase r A ∧ |Bi A| =o wrank r A" using b1 by blast
then have b4: "∀ A ∈ S. |Bi A| <o α" using assms ordIso_ordLess_trans by blast
obtain S' where b5: "S' = Bi ` S" by blast
then have "|S'| ≤o |S| ∧ (∀ X ∈ S'. |X| <o α)" using b4 by simp
moreover then have "|S'| <o α" using a2 by (metis ordLeq_ordLess_trans)
ultimately have "|⋃S'| <o α" using a3 lem_card_un_bnd_stab[of α S'] by blast
moreover obtain B where b6: "B = (⋃A∈S. Bi A)" by blast
ultimately have b7: "|B| <o α" using b5 by simp
have "∀A∈S. A ⊆ w_dncl r (Bi A)" using b3 unfolding wbase_def by blast
then have "⋃S ⊆ w_dncl r B" using b6 lem_wdn_mon[of _ B r] by blast
then have "B ∈ wbase r (⋃S)" unfolding wbase_def by blast
then have "wrank r (⋃S) ≤o |B|" using lem_wrank_uset_mem_bnd by blast
then show ?thesis using b7 by (metis ordLeq_ordLess_trans)
qed
lemma lem_wrank_fw:
fixes r::"'U rel" and K::"'U set" and α::"'U rel"
assumes a1: "ω_ord ≤o α" and a2: "wrank r K ≤o α" and a3: "∀ b∈K. wrank r (r``{b}) ≤o α"
shows "wrank r (⋃b∈K. (r``{b})) ≤o α"
proof -
obtain h where b1: "h = (λ A B. B ∈ wbase r A ∧ |B| =o wrank r A)" by blast
obtain Bi where b2: "Bi = (λ b. SOME B. h (r``{b}) B)" by blast
have "∀b∈K. ∃ B. h (r``{b}) B" using b1 lem_wrank_uset[of r] by blast
then have "∀b∈K. h (r``{b}) (Bi b)" using b2 by (metis someI_ex)
then have b3: "∀b∈K. (Bi b) ∈ wbase r (r``{b}) ∧ |Bi b| =o wrank r (r``{b})" using b1 by blast
obtain BK where b4: "BK ∈ wbase r K ∧ |BK| =o wrank r K" using lem_wrank_uset[of r K] by blast
obtain BU where b5: "BU = BK ∪ (⋃b∈(K∩BK). Bi b)" by blast
obtain S where b6: "S = (⋃b∈K. (r``{b}))" by blast
have b7: "∀ b ∈ K∩BK. (r``{b}) ⊆ w_dncl r BU"
proof
fix b
assume "b ∈ K ∩ BK"
then have "Bi b ⊆ BU ∧ (Bi b) ∈ wbase r (r``{b})" using b3 b5 by blast
then show "r``{b} ⊆ w_dncl r BU" using lem_wdn_mon unfolding wbase_def by blast
qed
have "BU ∈ wbase r S"
proof -
have "∀ b ∈ K. r``{b} ⊆ dncl r BU"
proof
fix b
assume d1: "b ∈ K"
show "r``{b} ⊆ dncl r BU"
proof (cases "b ∈ BK")
assume "b ∈ BK"
then show ?thesis using d1 b7 unfolding w_dncl_def by blast
next
assume e1: "b ∉ BK"
have "∀ t ∈ r``{b}. t ∉ dncl r BU ⟶ False"
proof (intro ballI impI)
fix t
assume f1: "t ∈ r``{b}" and f2: "t ∉ dncl r BU"
then have f3: "t ∉ dncl r BK" using b5 unfolding dncl_def by blast
moreover have "b ∈ w_dncl r BK" using d1 b4 unfolding wbase_def by blast
ultimately have f4: "∀F ∈ ℱ r b t. F ∩ BK ≠ {}" unfolding w_dncl_def by blast
obtain f where f5: "f = (λ n::nat. if (n = 0) then b else t)" by blast
then have "f 0 = b ∧ f 1 = t" by simp
moreover then have "∀i<1. (f i, f (Suc i)) ∈ r" using f1 by simp
ultimately have "f ∈ rpth r b t 1 ∧ {b, t} = f ` {i. i ≤ 1}"
using f5 unfolding rpth_def by force
then have "{b, t} ∈ ℱ r b t" unfolding ℱ_def by blast
then have "{b, t} ∩ BK ≠ {}" using f4 by blast
then show "False" using e1 f3 unfolding dncl_def by blast
qed
then show ?thesis by blast
qed
qed
then have c1: "S ⊆ dncl r BU" using b6 by blast
moreover have "∀ x ∈ S. ∀c. ∀F∈ℱ r x c. c ∉ dncl r BU ⟶ F ∩ BU ≠ {}"
proof (intro ballI allI impI)
fix x c F
assume d1: "x ∈ S" and d2: "F ∈ ℱ r x c" and d3: "c ∉ dncl r BU"
then obtain b where d4: "b ∈ K ∧ (b,x) ∈ r" using b6 by blast
show "F ∩ BU ≠ {}"
proof (cases "b ∈ BK")
assume "b ∈ BK"
then have "x ∈ w_dncl r BU" using b7 d4 by blast
then show ?thesis using d2 d3 unfolding w_dncl_def by blast
next
assume e1: "b ∉ BK"
have e2: "b ∈ w_dncl r BK" using d4 b4 unfolding wbase_def by blast
obtain f n where e3: "f ∈ rpth r x c n" and e4: "F = f ` {i. i≤n}"
using d2 unfolding ℱ_def by blast
obtain g where e5: "g = (λ k::nat. if (k=0) then b else (f (k-1)))" by blast
then have "g ∈ rpth r b c (Suc n)"
using e3 d4 unfolding rpth_def
by (simp, metis Suc_le_eq diff_Suc_Suc diff_zero gr0_implies_Suc less_Suc_eq_le)
then have "g ` {i. i ≤ (Suc n)} ∈ ℱ r b c ∧ c ∉ dncl r BK"
using d3 b5 unfolding ℱ_def dncl_def by blast
then have "g ` {i. i ≤ (Suc n)} ∩ BK ≠ {}" using e2 unfolding w_dncl_def by blast
moreover have "g ` {i. i ≤ (Suc n)} ⊆ F ∪ {b}"
proof
fix a
assume "a ∈ g ` {i. i ≤ (Suc n)}"
then obtain i where "i ≤ (Suc n) ∧ a = g i" by blast
then show "a ∈ F ∪ {b}" using e4 e5 by force
qed
ultimately have "(F ∪ {b}) ∩ BK ≠ {}" by blast
then show ?thesis using e1 b5 by blast
qed
qed
ultimately have "S ⊆ w_dncl r BU" unfolding w_dncl_def by blast
then show ?thesis unfolding wbase_def by blast
qed
moreover have "|BU| ≤o α"
proof -
have c1: "|BK| ≤o α" using b4 a2 by (metis ordIso_ordLeq_trans)
then have "|K ∩ BK| ≤o α" by (meson card_of_mono1 inf_le2 ordLeq_transitive)
then have "|Bi ` (K ∩ BK)| ≤o α" by (metis card_of_image ordLeq_transitive)
moreover have "∀ b∈(K∩BK). |Bi b| ≤o α" using b3 a3 by (meson Int_iff ordIso_ordLeq_trans)
ultimately have "|⋃(Bi ` (K ∩ BK))| ≤o α" using a1 lem_card_un_bnd[of "Bi`(K∩BK)" α] by blast
then show "|BU| ≤o α" using c1 b5 a1 lem_card_un2_bnd[of α BK "⋃(Bi ` (K ∩ BK))"] by simp
qed
ultimately have "wrank r S ≤o α" using b6 lem_wrank_uset_mem_bnd ordLeq_transitive by blast
then show ?thesis using b6 by blast
qed
lemma lem_wrank_fw_stab:
fixes r::"'U rel" and K::"'U set" and α::"'U rel"
assumes a1: "ω_ord ≤o α ∧ stable α" and a2: "wrank r K <o α" and a3: "∀ b∈K. wrank r (r``{b}) <o α"
shows "wrank r (⋃b∈K. (r``{b})) <o α"
proof -
obtain h where b1: "h = (λ A B. B ∈ wbase r A ∧ |B| =o wrank r A)" by blast
obtain Bi where b2: "Bi = (λ b. SOME B. h (r``{b}) B)" by blast
have "∀b∈K. ∃ B. h (r``{b}) B" using b1 lem_wrank_uset[of r] by blast
then have "∀b∈K. h (r``{b}) (Bi b)" using b2 by (metis someI_ex)
then have b3: "∀b∈K. (Bi b) ∈ wbase r (r``{b}) ∧ |Bi b| =o wrank r (r``{b})" using b1 by blast
obtain BK where b4: "BK ∈ wbase r K ∧ |BK| =o wrank r K" using lem_wrank_uset[of r K] by blast
obtain BU where b5: "BU = BK ∪ (⋃b∈(K∩BK). Bi b)" by blast
obtain S where b6: "S = (⋃b∈K. (r``{b}))" by blast
have b7: "∀ b ∈ K∩BK. (r``{b}) ⊆ w_dncl r BU"
proof
fix b
assume "b ∈ K ∩ BK"
then have "Bi b ⊆ BU ∧ (Bi b) ∈ wbase r (r``{b})" using b3 b5 by blast
then show "r``{b} ⊆ w_dncl r BU" using lem_wdn_mon unfolding wbase_def by blast
qed
have "BU ∈ wbase r S"
proof -
have "∀ b ∈ K. r``{b} ⊆ dncl r BU"
proof
fix b
assume d1: "b ∈ K"
show "r``{b} ⊆ dncl r BU"
proof (cases "b ∈ BK")
assume "b ∈ BK"
then show ?thesis using d1 b7 unfolding w_dncl_def by blast
next
assume e1: "b ∉ BK"
have "∀ t ∈ r``{b}. t ∉ dncl r BU ⟶ False"
proof (intro ballI impI)
fix t
assume f1: "t ∈ r``{b}" and f2: "t ∉ dncl r BU"
then have f3: "t ∉ dncl r BK" using b5 unfolding dncl_def by blast
moreover have "b ∈ w_dncl r BK" using d1 b4 unfolding wbase_def by blast
ultimately have f4: "∀F ∈ ℱ r b t. F ∩ BK ≠ {}" unfolding w_dncl_def by blast
obtain f where f5: "f = (λ n::nat. if (n = 0) then b else t)" by blast
then have "f 0 = b ∧ f 1 = t" by simp
moreover then have "∀i<1. (f i, f (Suc i)) ∈ r" using f1 by simp
ultimately have "f ∈ rpth r b t 1 ∧ {b, t} = f ` {i. i ≤ 1}"
using f5 unfolding rpth_def by force
then have "{b, t} ∈ ℱ r b t" unfolding ℱ_def by blast
then have "{b, t} ∩ BK ≠ {}" using f4 by blast
then show "False" using e1 f3 unfolding dncl_def by blast
qed
then show ?thesis by blast
qed
qed
then have c1: "S ⊆ dncl r BU" using b6 by blast
moreover have "∀ x ∈ S. ∀c. ∀F∈ℱ r x c. c ∉ dncl r BU ⟶ F ∩ BU ≠ {}"
proof (intro ballI allI impI)
fix x c F
assume d1: "x ∈ S" and d2: "F ∈ ℱ r x c" and d3: "c ∉ dncl r BU"
then obtain b where d4: "b ∈ K ∧ (b,x) ∈ r" using b6 by blast
show "F ∩ BU ≠ {}"
proof (cases "b ∈ BK")
assume "b ∈ BK"
then have "x ∈ w_dncl r BU" using b7 d4 by blast
then show ?thesis using d2 d3 unfolding w_dncl_def by blast
next
assume e1: "b ∉ BK"
have e2: "b ∈ w_dncl r BK" using d4 b4 unfolding wbase_def by blast
obtain f n where e3: "f ∈ rpth r x c n" and e4: "F = f ` {i. i≤n}"
using d2 unfolding ℱ_def by blast
obtain g where e5: "g = (λ k::nat. if (k=0) then b else (f (k-1)))" by blast
then have "g ∈ rpth r b c (Suc n)"
using e3 d4 unfolding rpth_def
by (simp, metis Suc_le_eq diff_Suc_Suc diff_zero gr0_implies_Suc less_Suc_eq_le)
then have "g ` {i. i ≤ (Suc n)} ∈ ℱ r b c ∧ c ∉ dncl r BK"
using d3 b5 unfolding ℱ_def dncl_def by blast
then have "g ` {i. i ≤ (Suc n)} ∩ BK ≠ {}" using e2 unfolding w_dncl_def by blast
moreover have "g ` {i. i ≤ (Suc n)} ⊆ F ∪ {b}"
proof
fix a
assume "a ∈ g ` {i. i ≤ (Suc n)}"
then obtain i where "i ≤ (Suc n) ∧ a = g i" by blast
then show "a ∈ F ∪ {b}" using e4 e5 by force
qed
ultimately have "(F ∪ {b}) ∩ BK ≠ {}" by blast
then show ?thesis using e1 b5 by blast
qed
qed
ultimately have "S ⊆ w_dncl r BU" unfolding w_dncl_def by blast
then show ?thesis unfolding wbase_def by blast
qed
moreover have "|BU| <o α"
proof -
have c1: "|BK| <o α" using b4 a2 by (metis ordIso_imp_ordLeq ordLeq_ordLess_trans)
then have "|K ∩ BK| <o α" by (meson Int_iff card_of_mono1 ordLeq_ordLess_trans subsetI)
then have "|Bi ` (K ∩ BK)| <o α" by (metis card_of_image ordLeq_ordLess_trans)
moreover have "∀ b∈(K∩BK). |Bi b| <o α" using b3 a3 by (meson Int_iff ordIso_ordLess_trans)
ultimately have "|⋃(Bi ` (K ∩ BK))| <o α" using a1 lem_card_un_bnd_stab[of α "Bi`(K∩BK)"] by blast
then show "|BU| <o α" using c1 b5 a1 lem_card_un2_lsbnd[of α BK "⋃(Bi ` (K ∩ BK))"] by simp
qed
ultimately have "wrank r S <o α" using b6 lem_wrank_uset_mem_bnd[of BU r S] by (metis ordLeq_ordLess_trans)
then show ?thesis using b6 by blast
qed
lemma lem_wnb_neib:
fixes r::"'U rel" and α::"'U rel"
assumes a1: "ω_ord ≤o α" and a2: "α <o ∥r∥"
shows "∀ a ∈ Field r. ∃ b ∈ Mwn r α. (a,b) ∈ r^*"
proof
fix a
assume b1: "a ∈ Field r"
have "¬ (∃ b ∈ Mwn r α. (a,b) ∈ r^*) ⟶ False"
proof
assume c1: "¬ (∃ b ∈ Mwn r α. (a,b) ∈ r^*)"
obtain B where c2: "B = (r^*)``{a}" by blast
obtain S where c3: "S = ( (λ n. (r^^n)``{a}) ` (UNIV::nat set) )" by blast
have c4: "∀ b ∈ B. wrank r (r``{b}) ≤o α"
proof
fix b
assume d1: "b ∈ B"
then obtain k where "b ∈ (r^^k)``{a}" using c2 rtrancl_power by blast
moreover have "∀ n. (r^^n) `` {a} ⊆ Field r"
proof
fix n
show "(r^^n) `` {a} ⊆ Field r" using b1
by (induct n, force, meson FieldI2 Image_singleton_iff relpow_Suc_E subsetI)
qed
ultimately have "b ∈ Field r" by blast
moreover have "b ∉ Mwn r α" using d1 c1 c2 by blast
ultimately have "b ∈ Field r - Mwn r α" by blast
moreover have "Well_order α" using assms unfolding ordLess_def by blast
moreover have "Well_order (wrank r (r``{b}))" using lem_wrank_cardord by (metis card_order_on_well_order_on)
ultimately show "wrank r (r``{b}) ≤o α" unfolding Mwn_def by simp
qed
have "∀ n. wrank r ((r^^n)``{a}) ≤o α"
proof
fix n0
show "wrank r ((r^^n0)``{a}) ≤o α"
proof (induct n0)
have "|{a}| ≤o ω_ord" using card_of_Well_order finite.emptyI
infinite_iff_natLeq_ordLeq natLeq_Well_order ordLeq_total by blast
then have "|(r^^0)``{a}| ≤o ω_ord" by simp
then show "wrank r ((r^^0)``{a}) ≤o α"
using a1 lem_wrank_ub[of r "(r^^0)``{a}"] by (metis ordLeq_transitive)
next
fix n
assume e1: "wrank r ((r^^n)``{a}) ≤o α"
obtain K where e2: "K = (r^^n)``{a}" by blast
obtain S' where e3: "S' = ((λ b. r``{b}) ` K)" by blast
have "wrank r K ≤o α" using e1 e2 by blast
moreover have "∀A∈S'. wrank r A ≤o α"
proof
fix A
assume "A ∈ S'"
then obtain b where "b ∈ K ∧ A = r``{b}" using e3 by blast
moreover then have "b ∈ B" using c2 e2 rtrancl_power by blast
ultimately show "wrank r A ≤o α" using c4 by blast
qed
ultimately have e4: "wrank r (⋃ S') ≤o α"
using a1 e3 lem_wrank_fw[of α r K] by fastforce
have "(r^^(Suc n))``{a} = r``K" using e2 by force
moreover have "r``K = ⋃ S'" using e3 by blast
ultimately have "(r^^(Suc n))``{a} = ⋃ S'" using e2 by blast
then show "wrank r ((r^^(Suc n))``{a}) ≤o α" using e4 by simp
qed
qed
then have "∀A∈S. wrank r A ≤o α" using c3 by blast
moreover have "B = ⋃ S" using c2 c3 rtrancl_power
apply (simp)
by blast
moreover have "|S| ≤o α"
proof -
have "|S| ≤o |UNIV::nat set|" using c3 by simp
moreover have "|UNIV::nat set| =o ω_ord" using card_of_nat by blast
ultimately show ?thesis using a1 ordLeq_ordIso_trans ordLeq_transitive by blast
qed
ultimately have "wrank r B ≤o α" using a1 lem_wrank_un_bnd[of S r α] by blast
moreover obtain B0 where "B0 ∈ wbase r B ∧ |B0| =o wrank r B" using lem_wrank_uset[of r B] by blast
ultimately have c5: "B ⊆ dncl r B0 ∧ |B0| ≤o α"
unfolding wbase_def w_dncl_def using ordIso_ordLeq_trans by blast
have "(({}::'U rel) <o ∥r∥)" using a2 by (metis ordLeq_ordLess_trans ordLess_Well_order_simp ozero_def ozero_ordLeq)
then have c6: "CCR r" using lem_Rcc_eq1_31 by blast
obtain B1 where c7: "B1 = B0 ∩ Field r" by blast
then have c8: "|B1| ≤o α" using c5 by (meson IntE card_of_mono1 ordLeq_transitive subsetI)
have "B1 ⊆ Field r" using c7 by blast
moreover have "∀x ∈ Field r. ∃y ∈ B1. (x, y) ∈ r^*"
proof
fix x
assume e1: "x ∈ Field r"
then obtain y where "(x,y) ∈ r^* ∧ (a,y) ∈ r^*" using c6 b1 unfolding CCR_def by blast
moreover then have "y ∈ B" unfolding c2 by blast
moreover then obtain y' where "y' ∈ B0 ∧ (y,y') ∈ r^*" using c5 unfolding dncl_def by blast
ultimately have "y' ∈ B0 ∧ (x,y') ∈ r^*" by force
moreover then have "x = y' ∨ y' ∈ Field r" using lem_rtr_field[of x y'] by blast
ultimately have "y' ∈ B1 ∧ (x,y') ∈ r^*" using e1 c7 by blast
then show "∃y∈B1. (x, y) ∈ r^*" by blast
qed
ultimately have "B1 ∈ SCF r" unfolding SCF_def by blast
then have "scf r ≤o |B1|" using lem_scf_uset_mem_bnd by blast
then have "scf r ≤o α" using c8 by (metis ordLeq_transitive)
moreover have "∥r∥ =o scf r" using c6 lem_scf_ccr_scf_rcc_eq[of r] by blast
ultimately show "False" using a2 by (metis not_ordLeq_ordLess ordIso_ordLeq_trans)
qed
then show "∃ b ∈ Mwn r α. (a,b) ∈ r^*" by blast
qed
lemma lem_wnb_neib3:
fixes r::"'U rel"
assumes a1: "ω_ord <o ∥r∥" and a2: "stable ∥r∥"
shows "∀ a ∈ Field r. ∃ b ∈ Mwnm r. (a,b) ∈ r^*"
proof
fix a
assume b1: "a ∈ Field r"
have "¬ (∃ b ∈ Mwnm r. (a,b) ∈ r^*) ⟶ False"
proof
assume c1: "¬ (∃ b ∈ Mwnm r. (a,b) ∈ r^*)"
obtain B where c2: "B = (r^*)``{a}" by blast
obtain S where c3: "S = ( (λ n. (r^^n)``{a}) ` (UNIV::nat set) )" by blast
have c4: "∀ b ∈ B. wrank r (r ``{b}) <o ∥r∥"
proof
fix b
assume d1: "b ∈ B"
then obtain k where "b ∈ (r^^k)``{a}" using c2 rtrancl_power by blast
moreover have "∀ n. (r^^n) `` {a} ⊆ Field r"
proof
fix n
show "(r^^n) `` {a} ⊆ Field r" using b1
by (induct n, force, meson FieldI2 Image_singleton_iff relpow_Suc_E subsetI)
qed
ultimately have "b ∈ Field r" by blast
moreover have "b ∉ Mwnm r" using d1 c1 c2 by blast
ultimately have "b ∈ Field r - Mwnm r" by blast
moreover have "Well_order (wrank r (r``{b}))" using lem_wrank_cardord by (metis card_order_on_well_order_on)
moreover have "Well_order ∥r∥" using lem_rcc_cardord unfolding card_order_on_def by blast
ultimately show "wrank r (r``{b}) <o ∥r∥" unfolding Mwnm_def by simp
qed
have "∀ n. wrank r ((r^^n)``{a}) <o ∥r∥"
proof
fix n0
show "wrank r ((r^^n0)``{a}) <o ∥r∥"
proof (induct n0)
have "|{a}| ≤o ω_ord" using card_of_Well_order finite.emptyI
infinite_iff_natLeq_ordLeq natLeq_Well_order ordLeq_total by blast
then have "|(r^^0)``{a}| ≤o ω_ord" by simp
then show "wrank r ((r^^0)``{a}) <o ∥r∥"
using a1 lem_wrank_ub[of r "(r^^0)``{a}"] by (metis ordLeq_ordLess_trans)
next
fix n
assume e1: "wrank r ((r^^n)``{a}) <o ∥r∥"
obtain K where e2: "K = (r^^n)``{a}" by blast
obtain S' where e3: "S' = ((λ b. r``{b}) ` K)" by blast
have "wrank r K <o ∥r∥" using e1 e2 by blast
moreover have "∀A∈S'. wrank r A <o ∥r∥"
proof
fix A
assume "A ∈ S'"
then obtain b where "b ∈ K ∧ A = r``{b}" using e3 by blast
moreover then have "b ∈ B" using c2 e2 rtrancl_power by blast
ultimately show "wrank r A <o ∥r∥" using c4 by blast
qed
moreover have "ω_ord ≤o ∥r∥" using a1 by (metis ordLess_imp_ordLeq)
ultimately have e4: "wrank r (⋃ S') <o ∥r∥"
using e3 a2 lem_wrank_fw_stab[of "∥r∥" r K] by fastforce
have "(r^^(Suc n))``{a} = r``K" using e2 by force
moreover have "r``K = ⋃ S'" using e3 by blast
ultimately have "(r^^(Suc n))``{a} = ⋃ S'" using e2 by blast
then show "wrank r ((r^^(Suc n)) `` {a}) <o ∥r∥" using e4 by simp
qed
qed
then have "∀A∈S. wrank r A <o ∥r∥" using c3 by blast
moreover have "B = ⋃ S" using c2 c3 rtrancl_power
apply (simp)
by blast
moreover have "|S| <o ∥r∥"
proof -
have "|S| ≤o |UNIV::nat set|" using c3 by simp
moreover have "|UNIV::nat set| =o ω_ord" using card_of_nat by blast
ultimately show ?thesis using a1 ordLeq_ordIso_trans ordLeq_ordLess_trans by blast
qed
ultimately have "wrank r B <o ∥r∥" using a2 lem_wrank_un_bnd_stab[of S r "∥r∥"] by blast
moreover obtain B0 where "B0 ∈ wbase r B ∧ |B0| =o wrank r B" using lem_wrank_uset[of r B] by blast
ultimately have c5: "B ⊆ dncl r B0 ∧ |B0| <o ∥r∥"
unfolding wbase_def w_dncl_def
by (metis (no_types, lifting) mem_Collect_eq ordIso_ordLess_trans subsetI subset_trans)
have "(({}::'U rel) <o ∥r∥)" using a1 by (metis ordLeq_ordLess_trans ordLess_Well_order_simp ozero_def ozero_ordLeq)
then have c6: "CCR r" using lem_Rcc_eq1_31 by blast
obtain B1 where c7: "B1 = B0 ∩ Field r" by blast
then have c8: "|B1| <o ∥r∥" using c5 by (meson IntE card_of_mono1 ordLeq_ordLess_trans subsetI)
have "B1 ⊆ Field r" using c7 by blast
moreover have "∀x ∈ Field r. ∃y ∈ B1. (x, y) ∈ r^*"
proof
fix x
assume e1: "x ∈ Field r"
then obtain y where "(x,y) ∈ r^* ∧ (a,y) ∈ r^*" using c6 b1 unfolding CCR_def by blast
moreover then have "y ∈ B" unfolding c2 by blast
moreover then obtain y' where "y' ∈ B0 ∧ (y,y') ∈ r^*" using c5 unfolding dncl_def by blast
ultimately have "y' ∈ B0 ∧ (x,y') ∈ r^*" by force
moreover then have "x = y' ∨ y' ∈ Field r" using lem_rtr_field[of x y'] by blast
ultimately have "y' ∈ B1 ∧ (x,y') ∈ r^*" using e1 c7 by blast
then show "∃y∈B1. (x, y) ∈ r^*" by blast
qed
ultimately have "B1 ∈ SCF r" unfolding SCF_def by blast
then have "scf r ≤o |B1|" using lem_scf_uset_mem_bnd by blast
then have "scf r <o ∥r∥" using c8 by (metis ordLeq_ordLess_trans)
moreover have "∥r∥ =o scf r" using c6 lem_scf_ccr_scf_rcc_eq[of r] by blast
ultimately show "False" by (metis not_ordLess_ordIso ordIso_symmetric)
qed
then show "∃ b ∈ Mwnm r. (a,b) ∈ r^*" by blast
qed
lemma lem_scfgew_ncl: "ω_ord ≤o scf r ⟹ ¬ Conelike r"
proof (cases "CCR r")
assume "ω_ord ≤o scf r" and "CCR r"
then have "ω_ord ≤o ∥r∥" using lem_scf_ccr_scf_rcc_eq[of r]
by (metis ordIso_iff_ordLeq ordLeq_transitive)
then have "∀ a. ¬ ( ∥r∥ ≤o |{a}| )" using finite_iff_ordLess_natLeq
ordLess_ordLeq_trans[of _ ω_ord "∥r∥"] not_ordLess_ordLeq[of _ "∥r∥"] by blast
then show "¬ Conelike r" using lem_Rcc_eq2_12[of r] by metis
next
assume "ω_ord ≤o scf r" and "¬ CCR r"
then show "¬ Conelike r" unfolding CCR_def Conelike_def by fastforce
qed
lemma lem_wnb_P_ncl_reg_grw:
fixes r::"'U rel"
assumes a1: "CCR r" and a2: "ω_ord <o scf r" and a3: "regularCard (scf r)"
shows "∃ P ∈ SCF r. (∀ α::'U rel. α <o scf r ⟶ (∀ a ∈ P. α <o wrank r (r``{a}) ))"
proof -
have "¬ Conelike r" using a2 lem_scfgew_ncl ordLess_imp_ordLeq by blast
moreover obtain P where b1: "P = { a ∈ Field r. scf r ≤o wrank r (r ``{a}) }" by blast
ultimately have "stable (scf r)"
using a1 a3 lem_scf_ccr_finscf_cl lem_scf_cardord regularCard_stable by blast
then have "stable ∥r∥" using a1 lem_scf_ccr_scf_rcc_eq stable_ordIso1 by blast
moreover have "ω_ord <o ∥r∥" using a1 a2 lem_scf_ccr_scf_rcc_eq[of r]
by (metis ordIso_iff_ordLeq ordLess_ordLeq_trans)
ultimately have "∀a∈Field r. ∃b ∈ Mwnm r. (a, b) ∈ r^*" using lem_wnb_neib3 by blast
moreover have "Mwnm r ⊆ P" unfolding b1 Mwnm_def using a1 lem_scf_ccr_scf_rcc_eq[of r]
by (clarsimp, metis ordIso_ordLeq_trans ordIso_symmetric)
moreover have "P ⊆ Field r" using b1 by blast
ultimately have "P ∈ SCF r" unfolding SCF_def by blast
moreover have "∀ α::'U rel. α <o scf r ⟶ (∀ a ∈ P. α <o wrank r (r``{a}) )"
using b1 ordLess_ordLeq_trans by blast
ultimately show ?thesis by blast
qed
lemma lem_wnb_P_ncl_nreg:
fixes r::"'U rel"
assumes a1: "CCR r" and a2: "ω_ord ≤o scf r" and a3: "¬ regularCard (scf r)"
shows "∃ Ps::'U set set. Ps ⊆ SCF r ∧ |Ps| <o scf r
∧ (∀ α::'U rel. α <o scf r ⟶ (∃ P ∈ Ps. ∀ a ∈ P. α <o wrank r (r``{a}) ))"
proof -
have "¬ Conelike r" using a2 lem_scfgew_ncl by blast
then have b1: "¬ finite (Field (scf r))" using a1 lem_scf_ccr_finscf_cl by blast
have b2: "⋀ α::'U rel. ω_ord ≤o α ⟹ α <o scf r ⟹ { a ∈ Field r. α <o wrank r (r ``{a}) } ∈ SCF r"
proof -
fix α::"'U rel"
assume c1: "ω_ord ≤o α" and c2: "α <o scf r"
have "α <o ∥r∥" using a1 c2 lem_scf_ccr_scf_rcc_eq ordIso_iff_ordLeq ordLess_ordLeq_trans by blast
then have "∀ a ∈ Field r. ∃ b ∈ Mwn r α. (a,b) ∈ r^*" using c1 lem_wnb_neib by blast
then show "{ a ∈ Field r. α <o wrank r (r ``{a}) } ∈ SCF r" unfolding SCF_def Mwn_def by blast
qed
have b3: "ω_ord <o scf r"
proof -
have c1: "¬ stable (scf r)" using b1 a3 lem_scf_cardord stable_regularCard by blast
have "ω_ord ≤o scf r" using b1 lem_inford_ge_w lem_scf_cardord unfolding card_order_on_def by blast
moreover have "ω_ord =o scf r ⟶ False" using c1 stable_ordIso stable_natLeq by blast
ultimately show ?thesis using ordLeq_iff_ordLess_or_ordIso by blast
qed
obtain S::"'U rel set" where b4: "|S| <o scf r" and b5: "∀α∈S. α <o scf r"
and b6: "∀α::('U rel). α <o scf r ⟶ (∃β∈S. α ≤o β)"
using b1 a3 lem_scf_cardord[of r] lem_card_nreg_inf_osetlm[of "scf r"] by blast
obtain S1::"'U rel set" where b7: "S1 = { α ∈ S. ω_ord ≤o α }" by blast
obtain f::"'U rel ⇒ 'U set" where b8: "f = (λ α. { a ∈ Field r. α <o wrank r (r ``{a}) })" by blast
obtain Ps::"'U set set" where b9: "Ps = f ` S1" by blast
have "Ps ⊆ SCF r" using b2 b5 b7 b8 b9 by blast
moreover have "|Ps| <o scf r"
proof -
have "|Ps| ≤o |S1|" using b9 by simp
moreover have "|S1| ≤o |S|" using b7 card_of_mono1[of S1 S] by blast
ultimately show ?thesis using b4 ordLeq_ordLess_trans ordLeq_transitive by blast
qed
moreover have "∀ α::'U rel. α <o scf r ⟶ (∃ P ∈ Ps. ∀ a ∈ P. α <o wrank r (r``{a}) )"
proof (intro allI impI)
fix α::"'U rel"
assume c1: "α <o scf r"
have "∃ αm::('U rel). ω_ord ≤o αm ∧ α ≤o αm ∧ αm <o scf r"
proof (cases "ω_ord ≤o α")
assume "ω_ord ≤o α"
then show ?thesis using c1 ordLeq_reflexive unfolding ordLeq_def by blast
next
assume "¬ (ω_ord ≤o α)"
then have d1: "α ≤o ω_ord" using c1 natLeq_Well_order ordLess_Well_order_simp
ordLess_imp_ordLeq ordLess_or_ordLeq by blast
have "isLimOrd (scf r)"
using b1 lem_scf_cardord[of r] card_order_infinite_isLimOrd[of "scf r"] by blast
then obtain αm::"'U rel" where "ω_ord ≤o αm ∧ αm <o scf r"
using b3 lem_lmord_prec[of ω_ord "scf r"] ordLess_imp_ordLeq by blast
then show ?thesis using d1 ordLeq_transitive by blast
qed
then obtain αm::"'U rel" where "ω_ord ≤o αm ∧ α ≤o αm ∧ αm <o scf r" by blast
moreover then obtain β::"'U rel" where "β ∈ S ∧ αm ≤o β" using b6 by blast
ultimately have c2: "α ≤o β" and c3: "β ∈ S1" using b7 ordLeq_transitive by blast+
obtain P where c4: "P = f β" by blast
then have "P ∈ Ps" using c3 b9 by blast
moreover have "∀ a ∈ P. α <o wrank r (r``{a})" using c2 c4 b8 ordLeq_ordLess_trans by blast
ultimately show "∃ P ∈ Ps. ∀ a ∈ P. α <o wrank r (r``{a})" by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Wf_ext_arc:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel" and a::"'U"
assumes a1: "scf r =o |Field r|" and a2: "f ∈ 𝒩 r Ps"
and a3: "∀γ::'U rel. γ <o scf r ⟶ (∀a ∈ P. γ <o wrank r (r``{a}))"
and a4: "ω_ord ≤o α" and a5: "a ∈ f α ∩ P"
shows "⋀ β. α <o β ∧ β <o |Field r| ∧ (β = {} ∨ isSuccOrd β) ⟹ (r``{a} ∩ (𝒲 r f β) ≠ {})"
proof (elim conjE)
fix β::"'U rel"
assume b1: "α <o β" and b2: "β <o |Field r|" and b3: "β = {} ∨ isSuccOrd β"
have b4: "ω_ord ≤o β" using b1 a4 by (metis ordLeq_ordLess_trans ordLess_imp_ordLeq)
have b5: "a ∈ (𝔏 f β) ∩ P" using b1 a5 unfolding 𝔏_def by blast
show "r``{a} ∩ (𝒲 r f β) ≠ {}"
proof -
have "r``{a} ⊆ w_dncl r (𝔏 f β) ∨ ( r``{a} ∩ (𝒲 r f β)≠{})"
using b2 b3 b5 a2 unfolding 𝒩_def 𝒩4_def using ordLess_imp_ordLeq by blast
moreover have "r``{a} ⊆ w_dncl r (𝔏 f β) ⟶ False"
proof
assume "r``{a} ⊆ w_dncl r (𝔏 f β)"
then have "𝔏 f β ∈ wbase r (r``{a})" unfolding wbase_def by blast
then have d1: "wrank r (r``{a}) ≤o |𝔏 f β|" using lem_wrank_uset_mem_bnd by blast
have "𝔏 f β ⊆ f β" using b2 a2 unfolding 𝒩_def 𝒩1_def 𝔏_def using ordLess_imp_ordLeq by blast
then have "|𝔏 f β| ≤o |f β|" by simp
moreover have "|f β| ≤o β" using a2 b2 b4 unfolding 𝒩_def 𝒩7_def using ordLess_imp_ordLeq by blast
ultimately have "wrank r (r``{a}) ≤o β" using d1 ordLeq_transitive by blast
moreover have "β <o wrank r (r `` {a})" using b2 b5 a1 a3 by (meson IntE ordIso_symmetric ordLess_ordIso_trans)
ultimately show "False" by (metis not_ordLeq_ordLess)
qed
ultimately show ?thesis by blast
qed
qed
lemma lem_Wf_esc_pth:
fixes r::"'U rel" and Ps::"'U set set" and f::"'U rel ⇒ 'U set" and α::"'U rel"
assumes a1: "Refl r ∧ ¬ finite r" and a2: "f ∈ 𝒩 r Ps"
and a3: "ω_ord ≤o |𝔏 f α|" and a4: "α <o |Field r|"
shows "⋀ F. F ∈ SCF (Restr r (f α)) ⟹
∀ a ∈ 𝒲 r f α. ∃ b ∈ (F ∩ (𝒲 r f α)). (a,b) ∈ (Restr r (𝒲 r f α))^*"
proof -
fix F
assume a5: "F ∈ SCF (Restr r (f α))"
show "∀ a ∈ (𝒲 r f α). ∃ b ∈ (F ∩ (𝒲 r f α)). (a,b) ∈ (Restr r (𝒲 r f α))^*"
proof
fix a
assume b1: "a ∈ 𝒲 r f α"
have b2: "SF r = {A. A ⊆ Field r}" using a1 unfolding SF_def refl_on_def Field_def by fast
moreover have "f α ⊆ Field r"
using a2 a4 unfolding 𝒩_def 𝒩5_def SF_def Field_def using ordLess_imp_ordLeq by blast
ultimately have "∀x ∈ f α. ∃y ∈ f α ∩ F. (x, y) ∈ (Restr r (f α))^*"
using a5 unfolding SF_def SCF_def by blast
then have b3: "∀x ∈ 𝒬 r f α. ∃y ∈ (f α ∩ F ∩ 𝒬 r f α). (x, y) ∈ (Restr r (𝒬 r f α))^*"
using lem_der_qinv3[of "(f α) ∩ F" f α r] by blast
have b4: "Restr r (𝒬 r f α) ∈ 𝔘 (Restr r (𝒲 r f α))"
using a1 a2 a3 a4 lem_der_inf_qw_restr_uset[of r f Ps α] by blast
moreover have "a ∈ Field (Restr r (𝒲 r f α))"
proof -
have "𝒲 r f α ⊆ Field r" using a2 a4 lem_qw_range ordLess_imp_ordLeq by blast
then have "𝒲 r f α ∈ SF r" using b2 by blast
then show ?thesis using b1 unfolding SF_def by blast
qed
ultimately obtain a' where b5: "a' ∈ 𝒬 r f α ∧ (a, a') ∈ (Restr r (𝒲 r f α))^*"
unfolding 𝔘_def Field_def by blast
then obtain b where b6: "b ∈ (f α ∩ F ∩ 𝒬 r f α) ∧ (a', b) ∈ (Restr r (𝒬 r f α))^*" using b3 by blast
then have "b ∈ (F ∩ (𝒲 r f α)) ∧ (a, b) ∈ (Restr r (𝒲 r f α))^*"
using b5 lem_QS_subs_WS[of r f α] rtrancl_mono[of "Restr r (𝒬 r f α)" "Restr r (𝒲 r f α)"] by force
then show "∃ b ∈ (F ∩ (𝒲 r f α)). (a,b) ∈ (Restr r (𝒲 r f α))^*" by blast
qed
qed
lemma lem_Nf_lewfbnd:
assumes a1: "f ∈ 𝒩 r Ps" and a2: "α ≤o |Field r|" and a3: "ω_ord ≤o |𝔏 f α|"
shows "ω_ord ≤o α"
proof -
have "𝔏 f α ⊆ f α" using a1 a2 unfolding 𝒩_def 𝒩1_def 𝔏_def using ordLess_imp_ordLeq by blast
then have "ω_ord ≤o |f α|" using a3 by (metis card_of_mono1 ordLeq_transitive)
moreover have "α <o ω_ord ⟶ |f α| <o ω_ord" using a1 a2 unfolding 𝒩_def 𝒩7_def by blast
ultimately show ?thesis using a2 not_ordLess_ordLeq by force
qed
lemma lem_regcard_iso: "κ =o κ' ⟹ regularCard κ' ⟹ regularCard κ"
proof -
assume a1: "κ =o κ'" and a2: "regularCard κ'"
then obtain f where b1: "iso κ κ' f" unfolding ordIso_def by blast
have "∀K. K ⊆ Field κ ∧ cofinal K κ ⟶ |K| =o κ"
proof (intro allI impI)
fix K
assume c1: "K ⊆ Field κ ∧ cofinal K κ"
moreover then obtain K' where c2: "K' = f ` K" by blast
ultimately have "K' ⊆ Field κ'" using b1 unfolding iso_def bij_betw_def by blast
moreover have "cofinal K' κ'"
proof -
have "∀a'∈Field κ'. ∃b'∈K'. a' ≠ b' ∧ (a', b') ∈ κ'"
proof
fix a'
assume "a' ∈ Field κ'"
then obtain a where e1: "a' = f a ∧ a ∈ Field κ" using b1 unfolding iso_def bij_betw_def by blast
then obtain b where e2: "b ∈ K ∧ a ≠ b ∧ (a, b) ∈ κ" using c1 unfolding cofinal_def by blast
then have "f b ∈ K'" using c2 by blast
moreover have "a' ≠ f b" using e1 e2 c1 b1 unfolding iso_def bij_betw_def inj_on_def by blast
moreover have "(a', f b) ∈ κ'"
proof -
have "(a,b) ∈ κ" using e2 by blast
moreover have "embed κ κ' f" using b1 unfolding iso_def by blast
ultimately have "(f a, f b) ∈ κ'" using compat_def embed_compat by metis
then show ?thesis using e1 by blast
qed
ultimately show "∃b'∈K'. a' ≠ b' ∧ (a', b') ∈ κ'" by blast
qed
then show ?thesis unfolding cofinal_def by blast
qed
ultimately have c3: "|K'| =o κ'" using a2 unfolding regularCard_def by blast
have "inj_on f K" using c1 b1 unfolding iso_def bij_betw_def inj_on_def by blast
then have "bij_betw f K K'" using c2 unfolding bij_betw_def by blast
then have "|K| =o |K'|" using card_of_ordIsoI by blast
then have "|K| =o κ'" using c3 ordIso_transitive by blast
then show "|K| =o κ" using a1 ordIso_symmetric ordIso_transitive by blast
qed
then show "regularCard κ" unfolding regularCard_def by blast
qed
lemma lem_cardsuc_inf_gwreg: "¬ finite A ⟹ κ =o cardSuc |A| ⟹ ω_ord <o κ ∧ regularCard κ"
proof -
assume a1: "¬ finite A" and a2: "κ =o cardSuc |A|"
moreover then have "regularCard (cardSuc |A| )" using infinite_cardSuc_regularCard by force
ultimately have a3: "regularCard κ" using lem_regcard_iso ordIso_transitive by blast
have "|A| <o cardSuc |A|" by simp
then have "|A| <o κ" using a2 ordIso_symmetric ordLess_ordIso_trans by blast
moreover have "ω_ord ≤o |A|" using a1 infinite_iff_natLeq_ordLeq by blast
ultimately have "ω_ord <o κ" using ordLeq_ordLess_trans by blast
then show ?thesis using a3 by blast
qed
lemma lem_ccr_rcscf_struct:
fixes r::"'U rel"
assumes a1: "Refl r" and a2: "CCR r" and a3: "ω_ord <o scf r" and a4: "regularCard (scf r)"
and a5: "scf r =o |Field r|"
shows "∃ Ps. ∃ f ∈ 𝒩 r Ps.
∀α. ω_ord ≤o |𝔏 f α| ∧ α <o |Field r| ∧ isSuccOrd α ⟶
CCR (Restr r (𝒲 r f α)) ∧ |Restr r (𝒲 r f α)| <o |Field r|
∧ (∀a ∈ 𝒲 r f α. wesc_rel r f α a (wesc r f α a))"
proof -
obtain P where b1: "P ∈ SCF r"
and b2: "∀α::'U rel. α <o scf r ⟶ (∀a ∈ P. α <o wrank r (r``{a}))"
using a2 a3 a4 lem_wnb_P_ncl_reg_grw[of r] by blast
then obtain f where b3: "f ∈ 𝒩 r {P}" using a1 a2 lem_Shinf_N_ne[of r "{P}"] by blast
moreover have "∀α. ω_ord ≤o |𝔏 f α| ∧ α <o |Field r| ∧ (α = {} ∨ isSuccOrd α) ⟶
CCR (Restr r (𝒲 r f α)) ∧ |Restr r (𝒲 r f α)| <o |Field r|
∧ (∀a ∈ 𝒲 r f α. wesc_rel r f α a (wesc r f α a))"
proof (intro allI impI)
fix α
assume c1: "ω_ord ≤o |𝔏 f α| ∧ α <o |Field r| ∧ (α = {} ∨ isSuccOrd α)"
then have c2: "(f α ∩ P) ∈ SCF (Restr r (f α))"
using b3 unfolding 𝒩_def 𝒩8_def using ordLess_imp_ordLeq by blast
have c3: "¬ finite r" using a2 a3 lem_scfgew_ncl lem_scf_ccr_scf_uset[of r]
unfolding 𝔘_def using ordLess_imp_ordLeq finite_subset[of _ r] by blast
have "CCR (Restr r (𝒲 r f α))" using c1 c3 b3 a1 lem_der_inf_qw_restr_ccr[of r f "{P}" α] by blast
moreover have "|Restr r (𝒲 r f α)| <o |Field r|" using c1 c3 b3 lem_der_inf_qw_restr_card[of r f "{P}" α] by blast
moreover have "∀a ∈ 𝒲 r f α. wesc_rel r f α a (wesc r f α a)"
proof
fix a
assume "a ∈ 𝒲 r f α"
then obtain b where d1: "b ∈ (P ∩ (𝒲 r f α))" and d2: "(a,b) ∈ (Restr r (𝒲 r f α))^*"
using c1 c2 c3 b3 a1 lem_Wf_esc_pth[of r f "{P}" α "f α ∩ P"] by blast
moreover then have "b ∈ (f α) ∩ P" unfolding 𝒲_def by blast
moreover have "ω_ord ≤o α" using c1 b3 lem_Nf_lewfbnd[of f r "{P}" α] ordLess_imp_ordLeq by blast
ultimately have "∀ β. α <o β ∧ β <o |Field r| ∧ (β = {} ∨ isSuccOrd β) ⟶ r `` {b} ∩ 𝒲 r f β ≠ {}"
using b2 b3 a5 lem_Wf_ext_arc[of r f "{P}" P α b] by blast
then have "wesc_rel r f α a b" using d1 d2 unfolding wesc_rel_def by blast
then have "∃ b. wesc_rel r f α a b" by blast
then show "wesc_rel r f α a (wesc r f α a)"
using someI_ex[of "λ b. wesc_rel r f α a b"] unfolding wesc_def by blast
qed
ultimately show "CCR (Restr r (𝒲 r f α))
∧ |Restr r (𝒲 r f α)| <o |Field r|
∧ (∀a ∈ 𝒲 r f α. wesc_rel r f α a (wesc r f α a))" by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_oint_infcard_sc_cf:
fixes α0::"'a rel" and κ::"'U rel" and S::"'U rel set"
assumes a1: "Card_order κ" and a2: "ω_ord ≤o κ"
and a3: "S = {α ∈ 𝒪::'U rel set. α0 ≤o α ∧ isSuccOrd α ∧ α <o κ}"
shows "∀ α ∈ S. ∃ β ∈ S. α <o β"
proof
fix α
assume b1: "α ∈ S"
then have "α <o κ" using a3 by blast
then obtain β where b2: "sc_ord α β" using lem_sucord_ex by blast
obtain β' where b3: "β' = nord β" by blast
have b4: "isSuccOrd β" using b2 unfolding sc_ord_def using lem_ordint_sucord by blast
moreover have "β =o β'" using b2 b3 lem_nord_l unfolding sc_ord_def ordLess_def by blast
ultimately have "isSuccOrd β'" using lem_osucc_eq by blast
moreover have "β' ∈ 𝒪" using b2 b3 lem_nordO_ls_r unfolding sc_ord_def by blast
moreover have "α0 ≤o β'" using b1 b2 b3 a3 unfolding sc_ord_def
using lem_nord_le_r ordLeq_ordLess_trans ordLess_imp_ordLeq by blast
moreover have "β' <o κ"
proof -
have "β ≤o κ" using b1 b2 a3 unfolding sc_ord_def by blast
moreover have "β =o κ ⟶ False"
proof
assume "β =o κ"
then have "isSuccOrd κ" using b4 lem_osucc_eq by blast
moreover have "isLimOrd κ" using a1 a2 lem_ge_w_inford by (metis card_order_infinite_isLimOrd)
moreover have "Well_order κ" using a1 unfolding card_order_on_def by blast
ultimately show "False" using wo_rel.isLimOrd_def unfolding wo_rel_def by blast
qed
ultimately have "β <o κ" using ordLeq_iff_ordLess_or_ordIso by blast
then show ?thesis using b3 lem_nord_ls_l by blast
qed
moreover have "α <o β'" using b2 b3 lem_nord_ls_r unfolding sc_ord_def by blast
ultimately have "β' ∈ S ∧ α <o β'" using a3 by blast
then show "∃ β ∈ S. α <o β" by blast
qed
lemma lem_oint_infcard_gew_sc_cfbnd:
fixes α0::"'a rel" and κ::"'U rel" and S::"'U rel set"
assumes a1: "Card_order κ" and a2: "ω_ord ≤o κ" and a3: "α0 <o κ" and a4: "α0 =o ω_ord"
and a5: "S = {α ∈ 𝒪::'U rel set. α0 ≤o α ∧ isSuccOrd α ∧ α <o κ}"
shows "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S|
∧ (∃ f. (∀ α ∈ 𝒪::'U rel set. α0 ≤o α ∧ α <o κ ⟶ α ≤o f α ∧ f α ∈ S))"
proof -
have "|UNIV::nat set| <o κ" using a3 a4 by (meson card_of_nat ordIso_ordLess_trans ordIso_symmetric)
then obtain N where "N ⊆ Field κ ∧ |UNIV::nat set| =o |N|"
using internalize_card_of_ordLess[of "UNIV::nat set" κ] by force
moreover obtain α0'::"'U rel" where "α0' = |N|" by blast
ultimately have b0: "α0' =o ω_ord" using card_of_nat ordIso_symmetric ordIso_transitive by blast
then have b0': "α0' <o κ" using a3 a4 ordIso_symmetric ordIso_ordLess_trans by metis
have b0'': "α0 =o α0'" using b0 a4 ordIso_symmetric ordIso_transitive by blast
obtain S1 where b1: "S1 = {α ∈ 𝒪::'U rel set. α0 ≤o α ∧ α <o κ}" by blast
obtain f where "f = (λα::'U rel. SOME β. sc_ord α β)" by blast
moreover have "∀ α ∈ S1. ∃ β. sc_ord α β" using b1 lem_sucord_ex by blast
ultimately have b2: "⋀ α. α ∈ S1 ⟹ sc_ord α (f α)" using someI_ex by metis
have b3: "(nord ∘ f) ` S1 ⊆ S"
proof
fix α
assume "α ∈ (nord ∘ f) ` S1"
then obtain α' where c1: "α' ∈ S1 ∧ α = nord (f α')" by force
then have c2: "sc_ord α' (f α')" using b2 by blast
then have c3: "isSuccOrd (f α')" unfolding sc_ord_def using lem_ordint_sucord by blast
moreover have "f α' =o α" using c1 c2 lem_nord_l unfolding sc_ord_def ordLess_def by blast
ultimately have c4: "isSuccOrd α" using lem_osucc_eq by blast
have "α0 ≤o α' ∧ α' <o κ" using c1 b1 by blast
then have c5: "α0 ≤o (f α') ∧ (f α') ≤o κ"
using c1 b2 unfolding sc_ord_def using ordLeq_ordLess_trans ordLess_imp_ordLeq by blast
then have c6: "α0 ≤o α" using c1 lem_nord_le_r by blast
have c7: "α ∈ 𝒪" using c1 c2 lem_nordO_ls_r unfolding sc_ord_def by blast
have "(f α') =o κ ⟶ False"
proof
assume "(f α') =o κ"
then have "isSuccOrd κ" using c3 lem_osucc_eq by blast
moreover have "isLimOrd κ" using a1 a2 lem_ge_w_inford by (metis card_order_infinite_isLimOrd)
moreover have "Well_order κ" using a1 unfolding card_order_on_def by blast
ultimately show "False" using wo_rel.isLimOrd_def unfolding wo_rel_def by blast
qed
then have "f α' <o κ" using c5 using ordLeq_iff_ordLess_or_ordIso by blast
then have "α <o κ" using c1 lem_nord_ls_l by blast
then show "α ∈ S" using c4 c6 c7 a5 by blast
qed
moreover have "inj_on (nord ∘ f) S1"
proof -
have "∀α∈S1. ∀β∈S1. (nord ∘ f) α = (nord ∘ f) β ⟶ α = β"
proof (intro ballI impI)
fix α β
assume d1: "α ∈ S1" and d2: "β ∈ S1" and "(nord ∘ f) α = (nord ∘ f) β"
then have "nord (f α) = nord (f β)" by simp
moreover have "Well_order (f α) ∧ Well_order (f β)"
using d1 d2 b2 unfolding sc_ord_def ordLess_def by blast
ultimately have d3: "f α =o f β" using lem_nord_req by blast
have d4: "sc_ord α (f α) ∧ sc_ord β (f β)" using d1 d2 b2 by blast
have "Well_order α ∧ Well_order β" using d1 d2 b1 unfolding ordLess_def by blast
moreover have "α <o β ⟶ False"
proof
assume "α <o β"
then have "f α ≤o β ∧ β <o f β" using d4 unfolding sc_ord_def by blast
then show "False" using d3 using not_ordLess_ordIso ordLeq_ordLess_trans by blast
qed
moreover have "β <o α ⟶ False"
proof
assume "β <o α"
then have "f β ≤o α ∧ α <o f α" using d4 unfolding sc_ord_def by blast
then show "False" using d3 using not_ordLess_ordIso ordLeq_ordLess_trans ordIso_symmetric by blast
qed
ultimately have "α =o β" using ordIso_or_ordLess by blast
then show "α = β" using d1 d2 b1 lem_Oeq by blast
qed
then show ?thesis unfolding inj_on_def by blast
qed
ultimately have b4: "|S1| ≤o |S|" using card_of_ordLeq by blast
obtain S2 where b5: "S2 = { α ∈ 𝒪::'U rel set. α <o α0 }" by blast
have b6: "|UNIV::nat set| ≤o |S1|"
proof -
obtain xi where c1: "xi = (λ i::nat. ((nord ∘ f)^^i) (nord α0'))" by blast
have c2: "∀ i. xi i ∈ S1"
proof
fix i0
show "xi i0 ∈ S1"
proof (induct i0)
have "α0' ≤o nord α0'"
using b0' lem_nord_l unfolding ordLess_def using ordIso_iff_ordLeq by blast
then have "α0 ≤o nord α0'" using b0'' ordIso_ordLeq_trans by blast
moreover then have "nord α0' <o κ ∧ nord α0' ∈ 𝒪"
using b0' lem_nordO_ls_l lem_nord_ls_l ordLeq_ordLess_trans by blast
ultimately show "xi 0 ∈ S1" using c1 b1 by simp
next
fix i
assume "xi i ∈ S1"
then have "(nord ∘ f) (xi i) ∈ S" using b3 by blast
then show "xi (Suc i) ∈ S1" using c1 b1 a5 by simp
qed
qed
have c3: "∀ j. ∀ i<j. xi i <o xi j"
proof
fix j0
show "∀i<j0. xi i <o xi j0"
proof (induct j0)
show "∀i<0. xi i <o xi 0" by blast
next
fix j
assume e1: "∀i<j. xi i <o xi j"
show "∀i<Suc j. xi i <o xi (Suc j)"
proof(intro allI impI)
fix i
assume f1: "i < Suc j"
have "xi j <o nord (f (xi j))" using c2 b2 unfolding sc_ord_def using lem_nord_ls_r by blast
then have "xi j <o xi (Suc j)" using c1 by simp
moreover then have "i < j ⟶ xi i <o xi (Suc j)" and "i = j ⟶ xi i <o xi (Suc j)"
using e1 ordLess_transitive by blast+
moreover have "i < j ∨ i = j" using f1 by force
ultimately show "xi i <o xi (Suc j)" by blast
qed
qed
qed
then have "∀ i j. xi i = xi j ⟶ i = j" by (metis linorder_neqE_nat ordLess_irreflexive)
then have "inj xi" unfolding inj_on_def by blast
moreover have "xi ` UNIV ⊆ S1" using c2 by blast
ultimately show "|UNIV::nat set| ≤o |S1|" using card_of_ordLeq by blast
qed
then have "¬ finite S1" using infinite_iff_card_of_nat by blast
moreover have "|S1| ≤o |S2| ∨ |S2| ≤o |S1|"
using card_of_Well_order ordLess_imp_ordLeq ordLess_or_ordLeq by blast
ultimately have "|S1 ∪ S2| ≤o |S1| ∨ |S1 ∪ S2| ≤o |S2|"
by (metis card_of_Un1 card_of_Un_ordLeq_infinite card_of_ordLeq_finite sup.idem)
moreover have "|S2| ≤o |S|"
proof -
have "|UNIV::nat set| ≤o |S|" using b4 b6 ordLeq_transitive by blast
moreover have "|S2| ≤o |UNIV::nat set|"
proof -
have "∀ α ∈ S2. α <o ω_ord ∧ α ∈ 𝒪" using b5 a4 ordLess_ordIso_trans by blast
then have d1: "∀ α ∈ S2. α =o natLeq_on (card (Field α)) ∧ α ∈ 𝒪" using lem_wolew_nat by blast
obtain A where d2: "A = natLeq_on ` UNIV" by blast
moreover obtain f where d3: "f = (λ α::'U rel. natLeq_on (card (Field α)))" by blast
ultimately have "f ` UNIV ⊆ A" by force
moreover have "inj_on f S2"
proof -
have "∀ α ∈ S2. ∀ β ∈ S2. f α = f β ⟶ α = β"
proof (intro ballI impI)
fix α β
assume "α ∈ S2" and "β ∈ S2" and "f α = f β"
then have "α =o natLeq_on (card (Field α))" and "β =o natLeq_on (card (Field β))"
and "natLeq_on (card (Field α)) = natLeq_on (card (Field β))"
and "α ∈ 𝒪 ∧ β ∈ 𝒪" using d1 d3 by blast+
moreover then have "α =o β"
by (metis (no_types, lifting) ordIso_symmetric ordIso_transitive)
ultimately show "α = β" using lem_Oeq by blast
qed
then show ?thesis unfolding inj_on_def by blast
qed
ultimately have "|S2| ≤o |A|" using card_of_ordLeq[of S2 A] by blast
moreover have "|A| ≤o |UNIV::nat set|" using d2 by simp
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately show ?thesis using ordLeq_transitive by blast
qed
ultimately have b7: "|S1 ∪ S2| ≤o |S|" using b4 ordLeq_transitive by blast
have "{α ∈ 𝒪::'U rel set. α <o κ} ⊆ S1 ∪ S2" using b1 b5 a1 a3 by fastforce
then have "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S1 ∪ S2|" by simp
moreover have "∀ α ∈ 𝒪::'U rel set. α0 ≤o α ∧ α <o κ ⟶ α ≤o (nord ∘ f) α ∧ (nord ∘ f) α ∈ S"
proof (intro ballI impI)
fix α::"'U rel"
assume c1: "α ∈ 𝒪" and c2: "α0 ≤o α ∧ α <o κ"
then have c3: "(nord ∘ f) α ∈ S" using b1 b3 by blast
moreover have "α <o f α" using c1 c2 b1 b2[of α] unfolding sc_ord_def by blast
then have "α ≤o f α" using ordLess_imp_ordLeq by blast
then have "α ≤o (nord ∘ f) α" using lem_nord_le_r by simp
then show "α ≤o (nord ∘ f) α ∧ (nord ∘ f) α ∈ S" using c3 by blast
qed
ultimately show ?thesis using b7 ordLeq_transitive by blast
qed
lemma lem_rcc_uset_rcc_bnd:
assumes "s ∈ 𝔘 r"
shows "∥r∥ ≤o ∥s∥"
proof -
obtain s0 where b1: "s0 ∈ 𝔘 r ∧ |s0| =o ∥r∥ ∧ |s0| ≤o |s| ∧ ( ∀ s' ∈ 𝔘 r. |s0| ≤o |s'| )"
using assms lem_rcc_uset_ne by blast
have "CCR s" using assms unfolding 𝔘_def by blast
then obtain t where b2: "t ∈ 𝔘 s ∧ |t| =o ∥s∥ ∧ ( ∀ s' ∈ 𝔘 s. |t| ≤o |s'| )"
using lem_Rcc_eq1_12 lem_rcc_uset_ne by blast
have "t ∈ 𝔘 r" using b2 assms lem_rcc_uset_tr by blast
then have "∥r∥ ≤o |t|" using lem_rcc_uset_mem_bnd by blast
then show "∥r∥ ≤o ∥s∥" using b2 ordLeq_ordIso_trans by blast
qed
lemma lem_dc2_ccr_scf_lew:
fixes r::"'U rel"
assumes a1: "CCR r" and a2: "scf r ≤o ω_ord"
shows "DCR 2 r"
proof -
have "∃ s. s ∈ 𝔘 r ∧ single_valued s"
proof (cases "scf r <o ω_ord")
assume "scf r <o ω_ord"
then have b1: "Conelike r" using a1 lem_scf_ccr_finscf_cl lem_fin_fl_rel lem_wolew_fin by blast
show ?thesis
proof (cases "r = {}")
assume "r = {}"
then have "r ∈ 𝔘 r ∧ single_valued r"
unfolding 𝔘_def CCR_def single_valued_def Field_def by blast
then show ?thesis by blast
next
assume "r ≠ {}"
then obtain m where c2: "m ∈ Field r ∧ (∀ a ∈ Field r. (a,m) ∈ r^*)"
using b1 unfolding Conelike_def by blast
then obtain a b where "(a,b) ∈ r ∧ (m = a ∨ m = b)" unfolding Field_def by blast
moreover obtain s where "s = {(a,b)}" by blast
ultimately have "s ∈ 𝔘 r" and "single_valued s"
using c2 unfolding 𝔘_def CCR_def Field_def single_valued_def by blast+
then show ?thesis by blast
qed
next
assume "¬ (scf r <o ω_ord)"
then have "scf r =o ω_ord" using a2 ordLeq_iff_ordLess_or_ordIso by blast
then obtain s where b1: "s ∈ Span r" and b2: "CCR s" and b3: "single_valued s"
using a1 lem_sv_span_scfeqw by blast
then have "s ∈ 𝔘 r ∧ single_valued s" unfolding Span_def 𝔘_def by blast
then show ?thesis by blast
qed
then obtain s where b1: "s ∈ 𝔘 r ∧ single_valued s" by blast
moreover have "DCR 1 s"
proof -
obtain g where "g = (λ α::nat. s)" by blast
moreover then have "DCR_generating g"
using b1 unfolding 𝔇_def single_valued_def DCR_generating_def by blast
ultimately show ?thesis unfolding DCR_def by blast
qed
ultimately have "DCR (Suc 1) r" using lem_Ldo_uset_reduc[of s r 1] by fastforce
moreover have "(Suc 1) = (2::nat)" by simp
ultimately show ?thesis by metis
qed
lemma lem_dc3_ccr_refl_scf_wsuc:
fixes r::"'U rel"
assumes a1: "Refl r" and a2: "CCR r"
and a3: "|Field r| =o cardSuc |UNIV::nat set|" and a4: "scf r =o |Field r|"
shows "DCR 3 r"
proof -
obtain κ::"'U rel" where b0: "κ = |Field r|" by blast
have b1: "ω_ord <o (scf r) ∧ regularCard (scf r)"
and b2: "ω_ord <o |Field r|"
using a3 a4 lem_cardsuc_inf_gwreg ordIso_transitive by blast+
then obtain Ps f
where b3: "f ∈ 𝒩 r Ps"
and b4: "⋀α. ω_ord ≤o |𝔏 f α| ∧ α <o κ ∧ isSuccOrd α ⟹
CCR (Restr r (𝒲 r f α)) ∧ |Restr r (𝒲 r f α)| <o κ
∧ (∀a ∈ 𝒲 r f α. wesc_rel r f α a (wesc r f α a))"
using b0 a1 a2 a4 lem_ccr_rcscf_struct by blast
have q0: "⋀ α. ω_ord ≤o α ∧ α <o κ ∧ isSuccOrd α ⟹ ¬ Conelike (Restr r (f α))"
proof -
fix α::"'U rel"
assume "ω_ord ≤o α ∧ α <o κ ∧ isSuccOrd α"
then have "Conelike (Restr r (f α)) ⟶ Conelike r"
using b3 b0 unfolding 𝒩_def 𝒩3_def 𝒩12_def clterm_def using ordLess_imp_ordLeq by blast
moreover have "Conelike r ⟶ False"
proof
assume "Conelike r"
then have "finite (Field (scf r))" using a2 lem_scf_ccr_finscf_cl by blast
then show "False" using b2 a4
by (metis Field_card_of infinite_iff_natLeq_ordLeq ordIso_finite_Field ordLess_imp_ordLeq)
qed
ultimately show "¬ Conelike (Restr r (f α))" by blast
qed
have q1: "⋀ α. ω_ord ≤o α ∧ α <o κ ∧ isSuccOrd α ⟹
ω_ord ≤o |𝔏 f α| ∧ scf (Restr r (f α)) =o ω_ord"
proof -
fix α::"'U rel"
assume c1: "ω_ord ≤o α ∧ α <o κ ∧ isSuccOrd α"
have "Card_order ω_ord ∧ ¬finite (Field ω_ord) ∧ Well_order ω_ord"
using natLeq_Card_order Field_natLeq by force
then have "¬ isSuccOrd ω_ord"
using card_order_infinite_isLimOrd wo_rel.isLimOrd_def wo_rel_def by blast
then have "ω_ord <o α" using c1 using lem_osucc_eq ordIso_symmetric ordLeq_iff_ordLess_or_ordIso by blast
then obtain α0::"'U rel" where c2: "ω_ord =o α0 ∧ α0 <o α" using internalize_ordLess[of ω_ord α] by blast
then have c3: "f α0 ⊆ 𝔏 f α" unfolding 𝔏_def by blast
obtain γ where c4: "γ = scf (Restr r (f α))" by blast
have "¬ Conelike (Restr r (f α))" using c1 q0 by blast
moreover have "CCR (Restr r (f α))" using c1 b0 b3 unfolding 𝒩_def 𝒩6_def
using ordLess_imp_ordLeq by blast
ultimately have "Card_order γ ∧ ¬ finite (Field γ)" and c5: "¬ finite (Restr r (f α))"
using c4 lem_scf_ccr_finscf_cl lem_scf_cardord lem_Relprop_fin_ccr by blast+
then have c6: "ω_ord ≤o γ"
by (meson card_of_Field_ordIso infinite_iff_natLeq_ordLeq ordIso_iff_ordLeq ordLeq_transitive)
have "ω_ord ≤o |𝔏 f α|" using c1 b0 b3 unfolding 𝒩_def 𝒩12_def using ordLess_imp_ordLeq by blast
moreover have "scf (Restr r (f α)) =o ω_ord"
proof -
have "|f α| ≤o α" using c1 b0 b3 unfolding 𝒩_def 𝒩7_def using ordLess_imp_ordLeq by blast
then have "|Restr r (f α)| ≤o α" using c1 lem_restr_ordbnd by blast
then have "γ ≤o α" using c4 c5 lem_rel_inf_fld_card[of "Restr r (f α)"]
lem_scf_relfldcard_bnd ordLeq_ordIso_trans ordLeq_transitive by blast
then have "γ <o cardSuc |UNIV::nat set|" using c1 b0 a3
using ordIso_iff_ordLeq ordLeq_ordLess_trans ordLess_ordLeq_trans by blast
moreover have "Card_order γ" using c4 lem_scf_cardord by blast
ultimately have "γ ≤o |UNIV::nat set|" by simp
then show ?thesis using c4 c6 using card_of_nat ordIso_iff_ordLeq ordLeq_ordIso_trans by blast
qed
ultimately show "ω_ord ≤o |𝔏 f α| ∧ scf (Restr r (f α)) =o ω_ord" by blast
qed
obtain is_st::"'U rel ⇒ 'U rel ⇒ bool"
where q3: "is_st = (λ s t. t ∈ Span s ∧ t ≠ {} ∧ CCR t ∧
single_valued t ∧ acyclic t ∧ (∀x∈Field t. t``{x} ≠ {}))" by blast
obtain st where q4: "st = (λ s::'U rel. SOME t. is_st s t)" by blast
have q5: "⋀ s. CCR s ∧ scf s =o ω_ord ⟹ is_st s (st s)"
proof -
fix s::"'U rel"
assume "CCR s ∧ scf s =o ω_ord"
then obtain t where "is_st s t" using q3 lem_sv_span_scfeqw[of s] by blast
then show "is_st s (st s)" using q4 someI_ex by metis
qed
obtain κ0 where b5: "κ0 = ω_ord" by blast
obtain S where b6: "S = {α ∈ 𝒪::'U rel set. κ0 ≤o α ∧ isSuccOrd α ∧ α <o κ}" by blast
obtain R where b8: "R = (λ α. st (Restr r (𝒲 r f α)))" by blast
obtain T::"'U rel set" where b11: "T = { t. t ≠ {} ∧ CCR t ∧ single_valued t ∧
acyclic t ∧ (∀x∈Field t. t``{x} ≠ {}) }" by blast
obtain W::"'U rel ⇒ 'U set" where b12: "W = (λ α. 𝒲 r f α)" by blast
obtain Wa where b13: "Wa = (⋃α∈S. W α)" by blast
obtain r1 where b14: "r1 = Restr r Wa" by blast
have b15: "⋀ α. α ∈ S ⟹ Restr r (𝒲 r f α) = Restr r1 (W α)" using b12 b13 b14 by blast
have b16: "⋀ α. α ∈ S ⟹ Restr r (𝒲 r f α) ∈ 𝔘 (Restr r (f α))"
proof -
fix α
assume c1: "α ∈ S"
have d1: "¬ finite r" using b2 lem_fin_fl_rel by (metis infinite_iff_natLeq_ordLeq ordLess_imp_ordLeq)
moreover have "α <o scf r" using c1 b0 b6 a4 using ordIso_symmetric ordLess_ordIso_trans by blast
moreover have "ω_ord ≤o |𝔏 f α|" using c1 b5 b6 q1 by blast
moreover have "isSuccOrd α" using c1 b6 by blast
ultimately show "Restr r (𝒲 r f α) ∈ 𝔘 (Restr r (f α))"
using b3 a1 a2 lem_der_qw_uset[of r f Ps α] by blast
qed
have "κ =o cardSuc |UNIV::nat set|" using b0 a3 by blast
moreover have "Refl r1" using a1 b14 unfolding refl_on_def Field_def by blast
moreover have "S ⊆ {α ∈ 𝒪::'U rel set. α <o κ}" using b6 by blast
moreover have b17: "|{α ∈ 𝒪::'U rel set. α <o κ}| ≤o |S|
∧ (∃h. ∀α∈𝒪::'U rel set. κ0 ≤o α ∧ α <o κ ⟶ α ≤o h α ∧ h α ∈ S)"
proof -
have "Card_order κ" using b0 by simp
moreover have "ω_ord ≤o κ" using b0 b2 ordLess_imp_ordLeq by blast
moreover have "κ0 <o κ" using b0 b2 b5 by blast
moreover have "κ0 =o ω_ord" using b5 ordIso_refl natLeq_Card_order by blast
ultimately show ?thesis using b6 lem_oint_infcard_gew_sc_cfbnd[of κ κ0 S] by blast
qed
moreover have "∀ α ∈ S. ∃ β ∈ S. α <o β"
proof -
have "Card_order κ" using b0 by simp
moreover have "ω_ord ≤o κ" using b0 b2 ordLess_imp_ordLeq by blast
ultimately show ?thesis using b6 lem_oint_infcard_sc_cf[of κ S κ0] by blast
qed
moreover have b18: "Field r1 = (⋃α∈S. W α)"
proof -
have "SF r = {A. A ⊆ Field r}" using a1 unfolding SF_def Field_def refl_on_def by fast
moreover have "Wa ⊆ Field r"
using b0 b3 b6 b12 b13 lem_qw_range[of f r Ps _] ordLess_imp_ordLeq[of _ κ] by blast
ultimately have "Field r1 = Wa" using b14 unfolding SF_def by blast
then show ?thesis using b13 by blast
qed
moreover have "∀α∈S. ∀ β∈S. α ≠ β ⟶ W α ∩ W β = {}"
proof (intro ballI impI)
fix α β
assume "α ∈ S" and "β ∈ S" and "α ≠ β"
then have "Well_order α ∧ Well_order β ∧ ¬ (α =o β)" using b6 lem_Owo lem_Oeq by blast
then show "W α ∩ W β = {}" using b12 lem_Der_inf_qw_disj by blast
qed
moreover have "⋀ α. α ∈ S ⟹ R α ∈ T ∧ R α ⊆ Restr r1 (W α) ∧ |W α| ≤o |UNIV::nat set|
∧ Field (R α) = W α ∧ ¬ Conelike (Restr r1 (W α))"
proof -
fix α
assume c1: "α ∈ S"
then have c2: "CCR (Restr r (𝒲 r f α)) ∧ scf (Restr r (f α)) =o ω_ord" using b4 q1 b5 b6 by blast
moreover have c3: "scf (Restr r (𝒲 r f α)) =o ω_ord ∧ |𝒲 r f α| ≤o |UNIV::nat set|"
proof -
have d1: "¬ finite r" using b2 lem_fin_fl_rel by (metis infinite_iff_natLeq_ordLeq ordLess_imp_ordLeq)
have "Restr r (𝒲 r f α) ∈ 𝔘 (Restr r (f α))" using c1 b16 by blast
then have d2: "∥Restr r (f α)∥ ≤o ∥Restr r (𝒲 r f α)∥" using lem_rcc_uset_rcc_bnd by blast
have "scf (Restr r (f α)) =o ω_ord" using c1 b5 b6 q1 by blast
moreover have "CCR (Restr r (f α))"
using c1 b0 b3 b6 unfolding 𝒩_def 𝒩6_def using ordLess_imp_ordLeq by blast
ultimately have "ω_ord =o ∥Restr r (f α)∥"
using lem_scf_ccr_scf_rcc_eq ordIso_symmetric ordIso_transitive by blast
then have d3: "ω_ord ≤o ∥Restr r (𝒲 r f α)∥" using d2 ordIso_ordLeq_trans by blast
have "|Restr r (𝒲 r f α)| <o |Field r|" using d1 c1 b0 b3 b6 lem_der_inf_qw_restr_card by blast
then have "|Restr r (𝒲 r f α)| <o cardSuc |UNIV::nat set|" using a3 ordLess_ordIso_trans by blast
then have d4: "|Restr r (𝒲 r f α)| ≤o |UNIV::nat set|" by simp
then have "∥Restr r (𝒲 r f α)∥ ≤o ω_ord" using lem_Rcc_relcard_bnd
by (metis ordLeq_transitive card_of_nat ordLeq_ordIso_trans)
then have "∥Restr r (𝒲 r f α)∥ =o ω_ord" using d3 using ordIso_iff_ordLeq by blast
moreover have "|𝒲 r f α| ≤o |UNIV::nat set|"
proof -
have "𝒲 r f α ⊆ f α" unfolding 𝒲_def by blast
then have "|𝒲 r f α| ≤o |f α|" by simp
moreover have "|f α| <o |Field r|" using c1 b3 b5 b6 b0 unfolding 𝒩_def 𝒩7_def
using ordLess_imp_ordLeq ordLeq_ordLess_trans by blast
ultimately have "|𝒲 r f α| <o cardSuc |UNIV::nat set|"
using a3 ordLeq_ordLess_trans ordLess_ordIso_trans by blast
then show ?thesis by simp
qed
ultimately show ?thesis using c2 lem_scf_ccr_scf_rcc_eq[of "Restr r (𝒲 r f α)"]
by (metis ordIso_symmetric ordIso_transitive)
qed
ultimately have c4: "is_st (Restr r (𝒲 r f α)) (R α)" using q5 b8 by blast
then have c5: "R α ∈ Span (Restr r (𝒲 r f α))" using q3 by blast
then have "Field (R α) = Field (Restr r (𝒲 r f α))" unfolding Span_def by blast
moreover have "SF r = {A. A ⊆ Field r}" using a1 unfolding SF_def refl_on_def Field_def by fast
moreover have "𝒲 r f α ⊆ Field r" using c1 b0 b3 b6 lem_qw_range ordLess_imp_ordLeq by blast
ultimately have "Field (R α) = 𝒲 r f α" unfolding SF_def by blast
then have "R α ⊆ Restr r1 (W α) ∧ Field (R α) = W α"
using c1 c5 b12 b13 b14 unfolding Span_def by blast
moreover have "R α ∈ T" using c4 q3 b11 by blast
moreover have "¬ Conelike (Restr r1 (W α))"
proof -
obtain s1 where d1: "s1 = Restr r (𝒲 r f α)" by blast
then have "scf s1 =o ω_ord ∧ CCR s1" using c2 c3 by blast
moreover then have "¬ finite (Field (scf s1))"
by (metis Field_natLeq infinite_UNIV_nat ordIso_finite_Field)
ultimately have "¬ Conelike s1" using lem_scf_ccr_finscf_cl by blast
then show ?thesis using d1 c1 b15[of α] by metis
qed
ultimately show "R α ∈ T ∧ R α ⊆ Restr r1 (W α) ∧ |W α| ≤o |UNIV::nat set|
∧ Field (R α) = W α ∧ ¬ Conelike (Restr r1 (W α))" using c3 b12 by blast
qed
moreover have "⋀ α x. α ∈ S ⟹ x ∈ W α ⟹
∃ a. ((x,a) ∈ (Restr r1 (W α))^* ∧ (∀ β ∈ S. α <o β ⟶ (r1``{a} ∩ W β) ≠ {}))"
proof -
fix α x
assume c1: "α ∈ S" and c2: "x ∈ W α"
moreover obtain a where "a = wesc r f α x" by blast
ultimately have "wesc_rel r f α x a" using b4 b0 b5 b6 b12 q1 by blast
then have c3: "a ∈ 𝒲 r f α ∧ (x,a) ∈ (Restr r (𝒲 r f α))^*" and
c4: "∀β. α <o β ∧ β <o |Field r| ∧ (β = {} ∨ isSuccOrd β) ⟶ r``{a} ∩ 𝒲 r f β ≠ {}"
unfolding wesc_rel_def by blast+
have "(x,a) ∈ (Restr r1 (W α))^*" using c1 c3 b15 by metis
moreover have "∀ β ∈ S. α <o β ⟶ (r1``{a} ∩ W β) ≠ {}"
proof (intro ballI impI)
fix β
assume d1: "β ∈ S" and "α <o β"
then obtain b where "(a,b) ∈ r ∧ b ∈ W β" using c4 b6 b0 b12 by blast
moreover then have "b ∈ Wa" using d1 b13 by blast
moreover have "a ∈ Wa" using c1 c3 b12 b13 by blast
ultimately have "(a,b) ∈ r1 ∧ b ∈ W β" using b14 by blast
then show "(r1``{a} ∩ W β) ≠ {}" by blast
qed
ultimately show "∃ a. ((x,a) ∈ (Restr r1 (W α))^*
∧ (∀ β ∈ S. α <o β ⟶ (r1``{a} ∩ W β) ≠ {}))" by blast
qed
ultimately obtain r' where b19: "CCR r' ∧ DCR 2 r' ∧ r' ⊆ r1"
and "∀ a ∈ Field r1. ∃ b ∈ Field r'. (a,b) ∈ r1^*"
using b11 lem_cfcomp_d2uset[of κ T r1 S W R] by blast
then have b20: "r' ∈ 𝔘 r1" unfolding 𝔘_def Span_def by blast
moreover have "r1 ∈ 𝔘 r"
proof -
have "∀ a ∈ Field r. ∃ α ∈ S. a ∈ f α"
proof
fix a
assume d1: "a ∈ Field r"
obtain A where d2: "A = {α ∈ 𝒪::'U rel set. κ0 ≤o α ∧ α <o κ}" by blast
have d3: "a ∈ f |Field r| ∧ ω_ord ≤o |Field r|" using d1 b3 b2
unfolding 𝒩_def 𝒩9_def using ordLess_imp_ordLeq by blast
moreover have "Card_order |Field r|" by simp
ultimately have "¬ ( |Field r| = {} ∨ isSuccOrd |Field r| )" using lem_card_inf_lim by blast
moreover have "|Field r| ≤o |Field r|" by simp
ultimately have "(∇ f |Field r| ) = {}" using b3 unfolding 𝒩_def 𝒩2_def by blast
then have "f |Field r| ⊆ 𝔏 f |Field r|" unfolding Dbk_def by blast
then obtain γ where d4: "γ <o κ ∧ a ∈ f γ" using d3 b0 unfolding 𝔏_def by blast
have "∃ α ∈ A. a ∈ f α"
proof (cases "κ0 ≤o γ")
assume "κ0 ≤o γ"
then have "nord γ ∈ A ∧ nord γ =o γ" using d4 d2 lem_nord_le_r lem_nord_ls_l
lem_nord_r lem_nordO_le_r ordLess_Well_order_simp by blast
moreover then have "f (nord γ) = f γ" using b3 unfolding 𝒩_def by blast
ultimately have "nord γ ∈ A ∧ a ∈ f (nord γ)" using d4 by blast
then show ?thesis by blast
next
assume "¬ κ0 ≤o γ"
moreover have "Well_order κ0 ∧ Well_order γ"
using d4 b5 natLeq_Well_order ordLess_Well_order_simp by blast
ultimately have "γ ≤o κ0" using ordLeq_total by blast
moreover have "κ0 <o κ" using b0 b2 b5 by blast
moreover then obtain α0::"'U rel" where "κ0 =o α0 ∧ α0 <o κ"
using internalize_ordLess[of κ0 κ] by blast
ultimately have "γ ≤o α0 ∧ κ0 ≤o α0 ∧ α0 <o κ"
using ordLeq_ordIso_trans ordIso_iff_ordLeq by blast
then have "γ ≤o nord α0 ∧ κ0 ≤o nord α0 ∧ nord α0 <o κ ∧ nord α0 ∈ 𝒪"
using lem_nord_le_r lem_nord_le_r lem_nord_ls_l lem_nordO_le_r
ordLess_Well_order_simp by blast
moreover then have "f γ ⊆ f (nord α0)"
using b3 b0 ordLess_imp_ordLeq unfolding 𝒩_def 𝒩1_def by blast
ultimately have "a ∈ f (nord α0) ∧ nord α0 ∈ A" using d4 d2 by blast
then show ?thesis by blast
qed
then obtain α α' where "α' ∈ S ∧ α ≤o α' ∧ α ∈ A ∧ a ∈ f α" using d2 b17 by blast
moreover then have "α' ≤o |Field r|" using b6 b0 using ordLess_imp_ordLeq by blast
ultimately have "α' ∈ S ∧ a ∈ f α'" using b3 b0 b0 unfolding 𝒩_def 𝒩1_def by blast
then show "∃ α ∈ S. a ∈ f α" by blast
qed
moreover have "∀ α ∈ S. f α ⊆ dncl r (Field r1)"
proof
fix α
assume d1: "α ∈ S"
show "f α ⊆ dncl r (Field r1)"
proof
fix a
assume "a ∈ f α"
moreover have "f α ∈ SF r" using d1 b0 b3 b6
unfolding 𝒩_def 𝒩5_def using ordLess_imp_ordLeq by blast
ultimately have "a ∈ Field (Restr r (f α))" unfolding SF_def by blast
moreover have "Restr r (𝒲 r f α) ∈ 𝔘 (Restr r (f α))" using d1 b16 by blast
ultimately obtain b where "b ∈ Field (Restr r (𝒲 r f α)) ∧ (a, b) ∈ (Restr r (f α))^*"
unfolding 𝔘_def by blast
then have "b ∈ 𝒲 r f α ∧ (a,b) ∈ r^*"
unfolding Field_def using rtrancl_mono[of "Restr r (f α)" r] by blast
moreover then have "b ∈ Field r1" using d1 b12 b18 by blast
ultimately show "a ∈ dncl r (Field r1)" unfolding dncl_def by blast
qed
qed
ultimately have "∀ a ∈ Field r. ∃ b ∈ Field r1. (a, b) ∈ r^*" unfolding dncl_def by blast
moreover have "CCR r1" using b20 lem_rcc_uset_ne_ccr by blast
moreover have "r1 ⊆ r" using b14 by blast
ultimately show "r1 ∈ 𝔘 r" unfolding 𝔘_def by blast
qed
ultimately have "r' ∈ 𝔘 r" using lem_rcc_uset_tr by blast
then show "DCR 3 r" using b19 lem_Ldo_uset_reduc[of r' r 2] by simp
qed
lemma lem_dc3_ccr_scf_lewsuc:
fixes r::"'U rel"
assumes a1: "CCR r" and a2: "|Field r| ≤o cardSuc |UNIV::nat set|"
shows "DCR 3 r"
proof (cases "scf r ≤o ω_ord")
assume "scf r ≤o ω_ord"
then have "DCR 2 r" using a1 lem_dc2_ccr_scf_lew by blast
moreover have "r ∈ 𝔘 r" using a1 unfolding 𝔘_def by blast
ultimately show "DCR 3 r" using lem_Ldo_uset_reduc[of r r 2] by simp
next
assume "¬ (scf r ≤o ω_ord)"
then have "ω_ord <o |Field r|" using lem_scf_relfldcard_bnd lem_scf_inf
by (metis ordIso_iff_ordLeq ordLeq_iff_ordLess_or_ordIso ordLeq_transitive)
then have "|UNIV::nat set| <o |Field r|" using card_of_nat ordIso_ordLess_trans by blast
then have "cardSuc |UNIV::nat set| ≤o |Field r|" by (meson cardSuc_ordLess_ordLeq card_of_Card_order)
then have b0: "|Field r| =o cardSuc |UNIV::nat set|" using a2
using not_ordLeq_ordLess ordLeq_iff_ordLess_or_ordIso by blast
obtain r1 where b1: "r1 = r ∪ {(x,y). x = y ∧ x ∈ Field r}" by blast
have b2: "Field r1 = Field r" using b1 unfolding Field_def by blast
have "r ∈ 𝔘 r1" using b1 b2 a1 unfolding 𝔘_def by blast
then have b3: "CCR r1" using lem_rcc_uset_ne_ccr[of r1] by blast
have "(¬ (scf r1 ≤o ω_ord)) ⟶ scf r1 =o |Field r1|"
proof
assume "¬ (scf r1 ≤o ω_ord)"
then have "ω_ord <o scf r1"
using lem_scf_inf by (metis ordIso_iff_ordLeq ordLeq_iff_ordLess_or_ordIso)
then have "|UNIV::nat set| <o scf r1 ∧ Card_order (scf r1)"
using lem_scf_cardord by (metis card_of_nat ordIso_ordLess_trans)
then have "cardSuc |UNIV::nat set| ≤o scf r1" by (meson cardSuc_ordLess_ordLeq card_of_Card_order)
then have "|Field r1| ≤o scf r1" using b0 b2 by (metis ordIso_ordLeq_trans)
then show "scf r1 =o |Field r1|" using lem_scf_relfldcard_bnd[of r1]
by (metis not_ordLeq_ordLess ordLeq_iff_ordLess_or_ordIso)
qed
moreover have "scf r1 ≤o ω_ord ⟶ DCR 3 r1"
proof
assume "scf r1 ≤o ω_ord"
then have "DCR 2 r1" using b3 lem_dc2_ccr_scf_lew by blast
moreover have "r1 ∈ 𝔘 r1" using b3 unfolding 𝔘_def by blast
ultimately show "DCR 3 r1" using lem_Ldo_uset_reduc[of r1 r1 2] by simp
qed
moreover have "scf r1 =o |Field r1| ⟶ DCR 3 r1"
proof
assume "scf r1 =o |Field r1|"
moreover have "Refl r1" using b1 unfolding refl_on_def Field_def by force
ultimately show "DCR 3 r1" using b0 b2 b3 lem_dc3_ccr_refl_scf_wsuc[of r1] by simp
qed
ultimately have "DCR 3 r1" by blast
moreover have "⋀ n. n ≠ 0 ⟹ DCR n r1 ⟹ DCR n r" using b1 lem_Ldo_eqid by blast
ultimately show "DCR 3 r" by force
qed
lemma lem_Cprf_conf_ccr_decomp:
fixes r::"'U rel"
assumes "confl_rel r"
shows "∃ S::('U rel set). (∀s∈S. CCR s) ∧ (r = ⋃ S) ∧ (∀ s1∈S. ∀s2∈S. s1 ≠ s2 ⟶ Field s1 ∩ Field s2 = {} )"
proof -
obtain 𝒟 where b1: "𝒟 = { D. ∃ x ∈ Field r. D = (r^<->*) `` {x} }" by blast
obtain S where b2: "S = { s. ∃ D ∈ 𝒟. s = Restr r D }" by blast
have "r = ⋃ S"
proof
show "r ⊆ ⋃ S"
proof
fix a b
assume d1: "(a,b) ∈ r"
then have "a ∈ Field r" unfolding Field_def by blast
moreover obtain D where d2: "D = (r^<->*) `` {a}" by blast
ultimately have "D ∈ 𝒟" using b1 by blast
moreover then have "(a,b) ∈ Restr r D" using d1 d2 by blast
ultimately show "(a,b) ∈ ⋃ S" using b2 by blast
qed
next
show "⋃ S ⊆ r" using b2 by blast
qed
moreover have "∀s1∈S. ∀s2∈S. Field s1 ∩ Field s2 ≠ {} ⟶ s1 = s2"
proof (intro ballI impI)
fix s1 s2
assume "s1 ∈ S" and "s2 ∈ S" and "Field s1 ∩ Field s2 ≠ {}"
moreover then obtain D1 D2 where c1: "D1 ∈ 𝒟 ∧ D2 ∈ 𝒟 ∧ s1 = Restr r D1 ∧ s2 = Restr r D2" using b2 by blast
ultimately have c2: "D1 ∩ D2 ≠ {}" unfolding Field_def by blast
obtain a b c where c3: "c ∈ D1 ∩ D2 ∧ D1 = (r^<->*) `` {a} ∧ D2 = (r^<->*) `` {b}" using b1 c1 c2 by blast
then have "(a,c) ∈ r^<->* ∧ (b,c) ∈ r^<->*" by blast
then have "(a,b) ∈ r^<->*" by (metis conversion_inv conversion_rtrancl rtrancl.intros(2))
moreover have "equiv UNIV (r^<->*)" unfolding equiv_def by (metis conversion_def refl_rtrancl conversion_sym trans_rtrancl)
ultimately have "D1 = D2" using c3 equiv_class_eq by simp
then show "s1 = s2" using c1 by blast
qed
moreover have "∀s∈S. CCR s"
proof
fix s
assume "s ∈ S"
then obtain D where c1: "D ∈ 𝒟 ∧ s = Restr r D" using b2 by blast
then obtain x where c2: "x ∈ Field r ∧ D = (r^<->*) `` {x}" using b1 by blast
have c3: "r `` D ⊆ D"
proof
fix b
assume "b ∈ r `` D"
then obtain a where d1: "a ∈ D ∧ (a,b) ∈ r" by blast
then have "(x,a) ∈ r^<->*" using c2 by blast
then have "(x,b) ∈ r^<->*" using d1
by (metis conversionI' conversion_rtrancl rtrancl.rtrancl_into_rtrancl rtrancl.rtrancl_refl)
then show "b ∈ D" using c2 by blast
qed
have c4: "r^* ∩ (D × (UNIV::'U set)) ⊆ s^*"
proof -
have "∀ n. ∀ a b. (a,b) ∈ r^^n ∧ a ∈ D ⟶ (a,b) ∈ s^*"
proof
fix n0
show "∀ a b. (a,b) ∈ r^^n0 ∧ a ∈ D ⟶ (a,b) ∈ s^*"
proof (induct n0)
show "∀a b. (a,b) ∈ r^^0 ∧ a ∈ D ⟶ (a,b) ∈ s^*" by simp
next
fix n
assume f1: "∀a b. (a,b) ∈ r^^n ∧ a ∈ D ⟶ (a,b) ∈ s^*"
show "∀a b. (a,b) ∈ r^^(Suc n) ∧ a ∈ D ⟶ (a,b) ∈ s^*"
proof (intro allI impI)
fix a b
assume g1: "(a,b) ∈ r^^(Suc n) ∧ a ∈ D"
moreover then obtain c where g2: "(a,c) ∈ r^^n ∧ (c,b) ∈ r" by force
ultimately have g3: "(a,c) ∈ s^*" using f1 by blast
have "c ∈ D" using c2 g1 g2
by (metis Image_singleton_iff conversionI' conversion_rtrancl relpow_imp_rtrancl rtrancl.rtrancl_into_rtrancl)
then have "(c,b) ∈ s" using c1 c3 g2 by blast
then show "(a,b) ∈ s^*" using g3 by (meson rtrancl.rtrancl_into_rtrancl)
qed
qed
qed
then show ?thesis using rtrancl_power by blast
qed
have "∀ a ∈ Field s. ∀ b ∈ Field s. ∃ c ∈ Field s. (a,c) ∈ s^* ∧ (b,c) ∈ s^*"
proof (intro ballI)
fix a b
assume d1: "a ∈ Field s" and d2: "b ∈ Field s"
then have d3: "a ∈ D ∧ b ∈ D" using c1 unfolding Field_def by blast
then have "(x,a) ∈ r^<->* ∧ (x,b) ∈ r^<->*" using c2 by blast
then have "(a,b) ∈ r^<->*" by (metis conversion_inv conversion_rtrancl rtrancl.rtrancl_into_rtrancl)
moreover have "CR r" using assms unfolding confl_rel_def Abstract_Rewriting.CR_on_def by blast
ultimately obtain c where "(a,c) ∈ r^* ∧ (b,c) ∈ r^*"
by (metis Abstract_Rewriting.CR_imp_conversionIff_join Abstract_Rewriting.joinD)
then have "(a,c) ∈ s^* ∧ (b,c) ∈ s^*" using c4 d3 by blast
moreover then have "c ∈ Field s" using d1 unfolding Field_def by (metis Range.intros Un_iff rtrancl.cases)
ultimately show "∃ c ∈ Field s. (a,c) ∈ s^* ∧ (b,c) ∈ s^*" by blast
qed
then show "CCR s" unfolding CCR_def by blast
qed
ultimately show ?thesis by blast
qed
lemma lem_Cprf_dc_disj_fld_un:
fixes S::"'U rel set" and n::nat
assumes a1: "∀ s1∈S. ∀s2∈S. s1≠s2 ⟶ Field s1 ∩ Field s2 = {}"
and a2: "∀ s∈S. DCR n s"
shows "DCR n (⋃ S)"
proof -
obtain gi::"'U rel ⇒ nat ⇒ 'U rel"
where b1: "gi = (λ s. (SOME g. DCR_generating g ∧ s = ⋃{r'. ∃α'<n. r' = g α'}))" by blast
obtain ga where b2: "ga = (λ α. if (α < n) then ⋃s∈S. gi s α else {})" by blast
have b3: "⋀ s. s ∈ S ⟹ DCR_generating (gi s) ∧ s = ⋃{r'. ∃α'<n. r' = gi s α'}"
proof -
fix s
assume "s ∈ S"
then obtain g where "DCR_generating g ∧ s = ⋃{r'. ∃α'<n. r' = g α'}"
using a2 unfolding DCR_def by force
then show "DCR_generating (gi s) ∧ s = ⋃{r'. ∃α'<n. r' = gi s α'}"
using b1 someI_ex[of "λ g. DCR_generating g ∧ s = ⋃{r'. ∃α'<n. r' = g α'}"] by blast
qed
have "∀α β a b c. (a, b) ∈ ga α ∧ (a, c) ∈ ga β ⟶
(∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 ga α β ∧ (c, c', c'', d) ∈ 𝔇 ga β α)"
proof (intro allI impI)
fix α β a b c
assume c1: "(a, b) ∈ ga α ∧ (a, c) ∈ ga β"
moreover have "α < n" using c1 b2 by (cases "α<n", simp+)
moreover have "β < n" using c1 b2 by (cases "β<n", simp+)
ultimately obtain s1 s2 where c2: "α < n ∧ s1 ∈ S ∧ (a,b) ∈ gi s1 α"
and c3: "β < n ∧ s2 ∈ S ∧ (a,c) ∈ gi s2 β" using c1 b2 by fastforce
then have "(a,b) ∈ s1 ∧ (a,c) ∈ s2" using b3 by blast
then have "s1 = s2 " using c2 c3 a1 unfolding Field_def by blast
then obtain b' b'' c' c'' d
where c4: "(b, b', b'', d) ∈ 𝔇 (gi s1) α β" and c5: "(c, c', c'', d) ∈ 𝔇 (gi s1) β α"
using c2 c3 b3[of s1] unfolding DCR_generating_def by blast
have "(b, b', b'', d) ∈ 𝔇 ga α β"
proof -
have d1: "(b, b') ∈ (𝔏1 (gi s1) α)^* ∧ (b', b'') ∈ (gi s1 β)^= ∧ (b'', d) ∈ (𝔏v (gi s1) α β)^*"
using c4 unfolding 𝔇_def by blast
have "𝔏1 (gi s1) α ⊆ 𝔏1 ga α"
proof
fix p
assume "p ∈ 𝔏1 (gi s1) α"
then obtain γ where "γ < α ∧ p ∈ gi s1 γ" unfolding 𝔏1_def by blast
moreover then have "p ∈ ga γ" using c2 b2 by fastforce
ultimately show "p ∈ 𝔏1 ga α" unfolding 𝔏1_def by blast
qed
then have d2: "(b, b') ∈ (𝔏1 ga α)^*" using d1 rtrancl_mono by blast
have "gi s1 β ⊆ ga β" using c2 c3 b2 by fastforce
then have d3: "(b', b'') ∈ (ga β)^=" using d1 by blast
have "𝔏v (gi s1) α β ⊆ 𝔏v ga α β"
proof
fix p
assume "p ∈ 𝔏v (gi s1) α β"
then obtain γ where "(γ < α ∨ γ < β) ∧ p ∈ gi s1 γ" unfolding 𝔏v_def by blast
moreover then have "p ∈ ga γ" using c2 c3 b2 by fastforce
ultimately show "p ∈ 𝔏v ga α β" unfolding 𝔏v_def by blast
qed
then have "(b'', d) ∈ (𝔏v ga α β)^*" using d1 rtrancl_mono by blast
then show ?thesis using d2 d3 unfolding 𝔇_def by blast
qed
moreover have "(c, c', c'', d) ∈ 𝔇 ga β α"
proof -
have d1: "(c, c') ∈ (𝔏1 (gi s1) β)^* ∧ (c', c'') ∈ (gi s1 α)^= ∧ (c'', d) ∈ (𝔏v (gi s1) β α)^*"
using c5 unfolding 𝔇_def by blast
have "𝔏1 (gi s1) β ⊆ 𝔏1 ga β"
proof
fix p
assume "p ∈ 𝔏1 (gi s1) β"
then obtain γ where "γ < β ∧ p ∈ gi s1 γ" unfolding 𝔏1_def by blast
moreover then have "p ∈ ga γ" using c2 c3 b2 by fastforce
ultimately show "p ∈ 𝔏1 ga β" unfolding 𝔏1_def by blast
qed
then have d2: "(c, c') ∈ (𝔏1 ga β)^*" using d1 rtrancl_mono by blast
have "gi s1 α ⊆ ga α" using c2 b2 by fastforce
then have d3: "(c', c'') ∈ (ga α)^=" using d1 by blast
have "𝔏v (gi s1) β α ⊆ 𝔏v ga β α"
proof
fix p
assume "p ∈ 𝔏v (gi s1) β α"
then obtain γ where "(γ < β ∨ γ < α) ∧ p ∈ gi s1 γ" unfolding 𝔏v_def by blast
moreover then have "p ∈ ga γ" using c2 c3 b2 by fastforce
ultimately show "p ∈ 𝔏v ga β α" unfolding 𝔏v_def by blast
qed
then have "(c'', d) ∈ (𝔏v ga β α)^*" using d1 rtrancl_mono by blast
then show ?thesis using d2 d3 unfolding 𝔇_def by blast
qed
ultimately show "∃b' b'' c' c'' d. (b, b', b'', d) ∈ 𝔇 ga α β ∧ (c, c', c'', d) ∈ 𝔇 ga β α" by blast
qed
then have "DCR_generating ga" unfolding DCR_generating_def by blast
moreover have "⋃ S = ⋃{r'. ∃α'<n. r' = ga α'}"
proof
show "⋃ S ⊆ ⋃{r'. ∃α'<n. r' = ga α'}"
proof
fix p
assume "p ∈ ⋃ S"
then obtain s where "s ∈ S ∧ p ∈ s" by blast
moreover then obtain α where "α<n ∧ p ∈ gi s α" using b3 by blast
ultimately have "α<n ∧ p ∈ ga α" using b2 by force
then show "p ∈ ⋃{r'. ∃α'<n. r' = ga α'}" by blast
qed
next
show "⋃{r'. ∃α'<n. r' = ga α'} ⊆ ⋃ S"
proof
fix p
assume "p ∈ ⋃{r'. ∃α'<n. r' = ga α'}"
then obtain α where "α<n ∧ p ∈ ga α" by blast
moreover then obtain s where "s ∈ S ∧ p ∈ gi s α" using b2 by force
ultimately have "s ∈ S ∧ p ∈ s" using b3 by blast
then show "p ∈ ⋃ S" by blast
qed
qed
ultimately show ?thesis unfolding DCR_def by blast
qed
lemma lem_dc3_to_d3:
fixes r::"'U rel"
assumes "DCR 3 r"
shows "DCR3 r"
proof -
obtain g where b1: "DCR_generating g" and b2: "r = ⋃{r'. ∃α'<3. r' = g α'}"
using assms unfolding DCR_def by blast
have "∀ α::nat. α<2 ⟷ α = 0 ∨ α = 1" by force
then have b3: "𝔏1 g 0 = {} ∧ 𝔏1 g 1 = g 0 ∧ 𝔏1 g 2 = g 0 ∪ g 1
∧ 𝔏v g 0 0 = {} ∧ 𝔏v g 1 0 = g 0 ∧ 𝔏v g 0 1 = g 0 ∧ 𝔏v g 1 1 = g 0
∧ 𝔏v g 2 0 = g 0 ∪ g 1 ∧ 𝔏v g 2 1 = g 0 ∪ g 1
∧ 𝔏v g 2 2 = g 0 ∪ g 1 ∧ 𝔏v g 0 2 = g 0 ∪ g 1 ∧ 𝔏v g 1 2 = g 0 ∪ g 1"
unfolding 𝔏1_def 𝔏v_def by (simp_all, blast+)
have "r = (g 0) ∪ (g 1) ∪ (g 2)"
proof
show "r ⊆ (g 0) ∪ (g 1) ∪ (g 2)"
proof
fix p
assume "p ∈ r"
then obtain α where "p ∈ g α ∧ α < 3" using b2 by blast
moreover have "∀ α::nat. α<3 ⟷ α = 0 ∨ α = 1 ∨ α = 2" by force
ultimately show "p ∈ (g 0) ∪ (g 1) ∪ (g 2)" by force
qed
next
have "(0::nat) < (3::nat) ∧ (1::nat) < (3::nat) ∧ (2::nat) < (3::nat)" by simp
then show "(g 0) ∪ (g 1) ∪ (g 2) ⊆ r" using b2 by blast
qed
moreover have "∀ a b c. (a,b) ∈ (g 0) ∧ (a,c) ∈ (g 0) ⟶ jn00 (g 0) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 0) ∧ (a,c) ∈ (g 0)"
then obtain b' b'' c' c'' d where "(b, b', b'', d) ∈ 𝔇 g 0 0 ∧ (c, c', c'', d) ∈ 𝔇 g 0 0"
using b1 unfolding DCR_generating_def by blast
then show "jn00 (g 0) b c" unfolding jn00_def 𝔇_def 𝔏1_def 𝔏v_def by force
qed
moreover have "∀ a b c. (a,b) ∈ (g 0) ∧ (a,c) ∈ (g 1) ⟶ jn01 (g 0) (g 1) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 0) ∧ (a,c) ∈ (g 1)"
then obtain b' b'' c' c'' d where
"(b, b', b'', d) ∈ 𝔇 g 0 1 ∧ (c, c', c'', d) ∈ 𝔇 g 1 0"
using b1 unfolding DCR_generating_def by blast
then show "jn01 (g 0) (g 1) b c" unfolding jn01_def 𝔇_def 𝔏1_def 𝔏v_def by force
qed
moreover have "∀ a b c. (a,b) ∈ (g 1) ∧ (a,c) ∈ (g 1) ⟶ jn11 (g 0) (g 1) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 1) ∧ (a,c) ∈ (g 1)"
then obtain b' b'' c' c'' d where "(b, b', b'', d) ∈ 𝔇 g 1 1 ∧ (c, c', c'', d) ∈ 𝔇 g 1 1"
using b1 unfolding DCR_generating_def by blast
then show "jn11 (g 0) (g 1) b c" unfolding jn11_def 𝔇_def
apply (simp only: b3)
by blast
qed
moreover have "∀ a b c. (a,b) ∈ (g 0) ∧ (a,c) ∈ (g 2) ⟶ jn02 (g 0) (g 1) (g 2) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 0) ∧ (a,c) ∈ (g 2)"
then obtain b' b'' c' c'' d where c1: "(b, b', b'', d) ∈ 𝔇 g 0 2 ∧ (c, c', c'', d) ∈ 𝔇 g 2 0"
using b1 unfolding DCR_generating_def by blast
then have "(c, c') ∈ (g 0 ∪ g 1)^* ∧ (c',c'') ∈ (g 0)^= ∧ (c'',d) ∈ (g 0 ∪ g 1)^*"
unfolding 𝔇_def by (simp add: b3)
moreover then have "(c',c'') ∈ (g 0 ∪ g 1)^*" by blast
ultimately have "(c, d) ∈ (g 0 ∪ g 1)^*" by force
then show "jn02 (g 0) (g 1) (g 2) b c"
using c1 unfolding jn02_def 𝔇_def
apply (simp add: b3)
by blast
qed
moreover have "∀ a b c. (a,b) ∈ (g 1) ∧ (a,c) ∈ (g 2) ⟶ jn12 (g 0) (g 1) (g 2) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 1) ∧ (a,c) ∈ (g 2)"
then obtain b' b'' c' c'' d where c1: "(b, b', b'', d) ∈ 𝔇 g 1 2 ∧ (c, c', c'', d) ∈ 𝔇 g 2 1"
using b1 unfolding DCR_generating_def by blast
then have "(c, c') ∈ (g 0 ∪ g 1)^* ∧ (c',c'') ∈ (g 1)^= ∧ (c'',d) ∈ (g 0 ∪ g 1)^*"
unfolding 𝔇_def apply (simp only: b3)
by blast
moreover then have "(c',c'') ∈ (g 0 ∪ g 1)^*" by blast
ultimately have "(c, d) ∈ (g 0 ∪ g 1)^*" by force
then show "jn12 (g 0) (g 1) (g 2) b c"
using c1 unfolding jn12_def 𝔇_def apply (simp only: b3)
by blast
qed
moreover have "∀ a b c. (a,b) ∈ (g 2) ∧ (a,c) ∈ (g 2) ⟶ jn22 (g 0) (g 1) (g 2) b c"
proof (intro allI impI)
fix a b c
assume "(a,b) ∈ (g 2) ∧ (a,c) ∈ (g 2)"
then obtain b' b'' c' c'' d where c1: "(b, b', b'', d) ∈ 𝔇 g 2 2 ∧ (c, c', c'', d) ∈ 𝔇 g 2 2"
using b1 unfolding DCR_generating_def by blast
then show "jn22 (g 0) (g 1) (g 2) b c"
unfolding jn22_def 𝔇_def apply (simp only: b3)
by blast
qed
ultimately have "LD3 r (g 0) (g 1) (g 2)" unfolding LD3_def by blast
then show ?thesis unfolding DCR3_def by blast
qed
lemma lem_dc3_confl_lewsuc:
fixes r::"'U rel"
assumes a1: "confl_rel r" and a2: "|Field r| ≤o cardSuc |UNIV::nat set|"
shows "DCR 3 r"
proof -
obtain S where b1: "r = ⋃ S"
and b2: "∀ s1 ∈ S. ∀ s2 ∈ S. s1 ≠ s2 ⟶ Field s1 ∩ Field s2 = {}"
and b3: "∀ s ∈ S. CCR s" using a1 lem_Cprf_conf_ccr_decomp[of r] by blast
have "∀ s∈S. DCR 3 s"
proof
fix s
assume "s ∈ S"
then have "CCR s ∧ Field s ⊆ Field r" using b1 b3 unfolding Field_def by blast
moreover then have "|Field s| ≤o |Field r|" by simp
ultimately have "CCR s ∧ |Field s| ≤o cardSuc |UNIV::nat set|" using a2 ordLeq_transitive by blast
then show "DCR 3 s" using lem_dc3_ccr_scf_lewsuc by blast
qed
then show "DCR 3 r" using b1 b2 lem_Cprf_dc_disj_fld_un[of S] by blast
qed
lemma lem_cle_eqdef: "|A| ≤o |B| = (∃ g . A ⊆ g`B)"
by (metis surj_imp_ordLeq card_of_ordLeq2 empty_subsetI order_refl)
lemma lem_cardLeN1_eqdef:
fixes A::"'a set"
shows "cardLeN1 A = ( |A| ≤o cardSuc |{n::nat . True}| )"
proof
assume b1: "cardLeN1 A"
obtain κ where b2: "κ = cardSuc |UNIV::nat set|" by blast
have "cardSuc |UNIV::nat set| <o |A| ⟶ False"
proof
assume "cardSuc |UNIV::nat set| <o |A|"
then have c1: "κ <o |A| ∧ |Field κ| =o κ" using b2 by simp
then have "|Field κ| ≤o |A|" using ordIso_ordLess_trans ordLess_imp_ordLeq by blast
then obtain B where c2: "B ⊆ A ∧ |Field κ| =o |B|"
using internalize_card_of_ordLeq2[of "Field κ" A] by blast
moreover have "|UNIV::nat set| <o κ" using b2 by simp
ultimately have c3: "B ⊆ A ∧ |UNIV::nat set| <o |B|"
using c1 by (meson ordIso_imp_ordLeq ordIso_symmetric ordLess_ordLeq_trans)
then obtain C where c4: "C ⊆ B ∧ |UNIV::nat set| =o |C|"
using internalize_card_of_ordLeq2[of "UNIV::nat set" B] ordLess_imp_ordLeq by blast
obtain c where "c ∈ C" using c4 using card_of_empty2 by fastforce
moreover obtain D where c5: "D = C - {c}" by blast
ultimately have c6: "C = D ∪ {c}" by blast
have "¬ finite D" using c4 c5 using card_of_ordIso_finite by force
moreover then have "|{c}| ≤o |D|" by (metis card_of_singl_ordLeq finite.emptyI)
ultimately have "|C| ≤o |D|" using c6 using card_of_Un_infinite ordIso_imp_ordLeq by blast
then obtain f where "C ⊆ f ` D" by (metis card_of_ordLeq2 empty_subsetI order_refl)
moreover have "D ⊂ C ∧ C ⊆ B ∧ B ⊆ A" using c3 c4 c5 c6 by blast
ultimately have "(∃f. B ⊆ f ` C) ∨ (∃g. A ⊆ g`B)" using b1 unfolding cardLeN1_def by metis
moreover have "(∃f. B ⊆ f ` C) ⟶ False"
proof
assume "∃f. B ⊆ f ` C"
then obtain f where "B ⊆ f ` C" by blast
then have "|B| ≤o |f`C|" by simp
moreover have "|f`C| ≤o |C|" by simp
ultimately have "|B| ≤o |C|" using ordLeq_transitive by blast
then show "False" using c3 c4 not_ordLess_ordIso ordLess_ordLeq_trans by blast
qed
moreover have "(∃g. A ⊆ g`B) ⟶ False"
proof
assume "∃g. A ⊆ g`B"
then obtain g where "A ⊆ g`B" by blast
then have "|A| ≤o |g`B|" by simp
moreover have "|g`B| ≤o |B|" by simp
ultimately have "|A| ≤o |B|" using ordLeq_transitive by blast
then show "False" using c1 c2
by (metis BNF_Cardinal_Order_Relation.ordLess_Field not_ordLess_ordIso ordLess_ordLeq_trans)
qed
ultimately show "False" by blast
qed
then show "|A| ≤o cardSuc |{n::nat . True}|" by simp
next
assume "|A| ≤o cardSuc |{n::nat . True}|"
then have b1: "|A| ≤o cardSuc |UNIV::nat set|" by simp
have "∀ B ⊆ A. ( ∀ C ⊆ B . ((∃ D f. D ⊂ C ∧ C ⊆ f`D ) ⟶ ( ∃ f. B ⊆ f`C )) )
∨ ( ∃ g . A ⊆ g`B )"
proof (intro allI impI)
fix B
assume "B ⊆ A"
show "(∀ C ⊆ B . ((∃ D f. D ⊂ C ∧ C ⊆ f`D ) ⟶ ( ∃ f. B ⊆ f`C ))) ∨ ( ∃ g . A ⊆ g`B )"
proof (cases "|B| ≤o |UNIV::nat set|")
assume d1: "|B| ≤o |UNIV::nat set|"
have "∀ C ⊆ B . ((∃ D f. D ⊂ C ∧ C ⊆ f`D ) ⟶ ( ∃ f. B ⊆ f`C ))"
proof (intro allI impI)
fix C
assume "C ⊆ B" and "∃ D f. D ⊂ C ∧ C ⊆ f`D"
then obtain D f where e1: "D ⊂ C ∧ C ⊆ f`D" by blast
have "finite C ⟶ False"
proof
assume "finite C"
moreover then have "finite D" using e1 finite_subset by blast
ultimately have "|D| <o |C|"
using e1 by (metis finite_card_of_iff_card3 psubset_card_mono)
moreover have "|C| ≤o |D|" using e1 using surj_imp_ordLeq by blast
ultimately show "False" using not_ordLeq_ordLess by blast
qed
then have "|B| ≤o |C|" using d1 by (metis infinite_iff_card_of_nat ordLeq_transitive)
then show "∃ f. B ⊆ f`C" by (metis card_of_ordLeq2 empty_subsetI order_refl)
qed
then show ?thesis by blast
next
assume "¬ |B| ≤o |UNIV::nat set|"
then have "|A| ≤o |B|" using b1 lem_cord_lin
by (metis cardSuc_ordLeq_ordLess card_of_Card_order ordLess_ordLeq_trans)
then have "∃ g . A ⊆ g`B" by (metis card_of_ordLeq2 empty_subsetI order_refl)
then show ?thesis by blast
qed
qed
then show "cardLeN1 A" unfolding cardLeN1_def by blast
qed
lemma lem_cleN1_eqdef:
fixes r::"('U×'U) set"
shows " ( |r| ≤o cardSuc |{n::nat . True}| )
⟷ ( ∀ s ⊆ r. ( ( ∀ t ⊆ s . ((∃ t' f. t' ⊂ t ∧ t ⊆ f`t') ⟶ (∃ f. s ⊆ f`t )) )
∨ ( ∃ g . r ⊆ g`s )
) )"
using lem_cardLeN1_eqdef[of r] cardLeN1_def by blast
subsubsection ‹Result›
text ‹The next theorem has the following meaning:
if the cardinality of a confluent binary relation $r$ does not exceed the first uncountable cardinal,
then confluence of $r$ can be proved with the help of the decreasing diagrams method
using no more than 3 labels (e.g. 0, 1, 2 ordered in the usual way).›
theorem thm_main:
fixes r::"('U×'U) set"
assumes "∀ a b c . (a,b) ∈ r^* ∧ (a,c) ∈ r^* ⟶ (∃ d. (b,d) ∈ r^* ∧ (c,d) ∈ r^*)"
and "|r| ≤o cardSuc |{n::nat . True}|"
shows "∃ r0 r1 r2 . (
( r = (r0 ∪ r1 ∪ r2) )
∧ ( ∀ a b c. (a,b) ∈ r0 ∧ (a,c) ∈ r0
⟶ (∃ d.
(b,d) ∈ r0^=
∧ (c,d) ∈ r0^= ) )
∧ ( ∀ a b c. (a,b) ∈ r0 ∧ (a,c) ∈ r1
⟶ (∃ b' d.
(b,b') ∈ r1^= ∧ (b',d) ∈ r0^*
∧ (c,d) ∈ r0^* ) )
∧ ( ∀ a b c. (a,b) ∈ r1 ∧ (a,c) ∈ r1
⟶ (∃ b' b'' c' c'' d.
(b,b') ∈ r0^* ∧ (b',b'') ∈ r1^= ∧ (b'',d) ∈ r0^*
∧ (c,c') ∈ r0^* ∧ (c',c'') ∈ r1^= ∧ (c'',d) ∈ r0^* ) )
∧ ( ∀ a b c. (a,b) ∈ r0 ∧ (a,c) ∈ r2
⟶ (∃ b' d.
(b,b') ∈ r2^= ∧ (b',d) ∈ (r0 ∪ r1)^*
∧ (c,d) ∈ (r0 ∪ r1)^* ) )
∧ ( ∀ a b c. (a,b) ∈ r1 ∧ (a,c) ∈ r2
⟶ ( ∃ b' b'' d.
(b,b') ∈ r0^* ∧ (b',b'') ∈ r2^= ∧ (b'',d) ∈ (r0 ∪ r1)^*
∧ (c,d) ∈ (r0 ∪ r1)^* ) )
∧ ( ∀ a b c. (a,b) ∈ r2 ∧ (a,c) ∈ r2
⟶ (∃ b' b'' c' c'' d.
(b,b') ∈ (r0 ∪ r1)^* ∧ (b',b'') ∈ r2^= ∧ (b'',d) ∈ (r0 ∪ r1)^*
∧ (c,c') ∈ (r0 ∪ r1)^* ∧ (c',c'') ∈ r2^= ∧ (c'',d) ∈ (r0 ∪ r1)^* ) )
)"
proof -
have b0: "|r| ≤o cardSuc |UNIV::nat set|" using assms(2) by simp
obtain κ where b1: "κ = cardSuc |UNIV::nat set|" by blast
have "|Field r| ≤o κ"
proof (cases "finite r")
assume "finite r"
then show ?thesis using b1 lem_fin_fl_rel by (metis Field_card_of Field_natLeq cardSuc_ordLeq_ordLess
card_of_card_order_on card_of_mono2 finite_iff_ordLess_natLeq ordLess_imp_ordLeq)
next
assume "¬ finite r"
then show ?thesis using b0 b1 lem_rel_inf_fld_card using ordIso_ordLeq_trans by blast
qed
moreover have "confl_rel r" using assms(1) unfolding confl_rel_def by blast
ultimately have "DCR3 r" using b1 lem_dc3_confl_lewsuc[of r] lem_dc3_to_d3 by blast
then show ?thesis unfolding DCR3_def LD3_def
jn00_def jn01_def jn02_def jn11_def jn12_def jn22_def by fast
qed
end