Theory Wellfounded
section ‹Well-founded Recursion›
theory Wellfounded
imports Transitive_Closure
begin
subsection ‹Basic Definitions›
definition wf_on :: "'a set ⇒ 'a rel ⇒ bool" where
"wf_on A r ⟷ (∀P. (∀x ∈ A. (∀y ∈ A. (y, x) ∈ r ⟶ P y) ⟶ P x) ⟶ (∀x ∈ A. P x))"
abbreviation wf :: "('a × 'a) set ⇒ bool" where
"wf ≡ wf_on UNIV"
definition wfp_on :: "'a set ⇒ ('a ⇒ 'a ⇒ bool) ⇒ bool" where
"wfp_on A R ⟷ (∀P. (∀x ∈ A. (∀y ∈ A. R y x ⟶ P y) ⟶ P x) ⟶ (∀x ∈ A. P x))"
abbreviation wfP :: "('a ⇒ 'a ⇒ bool) ⇒ bool" where
"wfP ≡ wfp_on UNIV"
alias wfp = wfP
text ‹We keep old name \<^const>‹wfP› for backward compatibility, but offer new name \<^const>‹wfp› to be
consistent with similar predicates, e.g., \<^const>‹asymp›, \<^const>‹transp›, \<^const>‹totalp›.›
subsection ‹Equivalence of Definitions›
lemma wfp_on_wf_on_eq[pred_set_conv]: "wfp_on A (λx y. (x, y) ∈ r) ⟷ wf_on A r"
by (simp add: wfp_on_def wf_on_def)
lemma wf_def: "wf r ⟷ (∀P. (∀x. (∀y. (y, x) ∈ r ⟶ P y) ⟶ P x) ⟶ (∀x. P x))"
unfolding wf_on_def by simp
lemma wfP_def: "wfP r ⟷ wf {(x, y). r x y}"
unfolding wf_def wfp_on_def by simp
lemma wfP_wf_eq: "wfP (λx y. (x, y) ∈ r) = wf r"
using wfp_on_wf_on_eq .
subsection ‹Induction Principles›
lemma wf_on_induct[consumes 1, case_names in_set less, induct set: wf_on]:
assumes "wf_on A r" and "x ∈ A" and "⋀x. x ∈ A ⟹ (⋀y. y ∈ A ⟹ (y, x) ∈ r ⟹ P y) ⟹ P x"
shows "P x"
using assms(2,3) by (auto intro: ‹wf_on A r›[unfolded wf_on_def, rule_format])
lemma wfp_on_induct[consumes 1, case_names in_set less, induct pred: wfp_on]:
assumes "wfp_on A r" and "x ∈ A" and "⋀x. x ∈ A ⟹ (⋀y. y ∈ A ⟹ r y x ⟹ P y) ⟹ P x"
shows "P x"
using assms by (fact wf_on_induct[to_pred])
lemma wf_induct:
assumes "wf r"
and "⋀x. ∀y. (y, x) ∈ r ⟶ P y ⟹ P x"
shows "P a"
using assms by (auto intro: wf_on_induct[of UNIV])
lemmas wfP_induct = wf_induct [to_pred]
lemmas wf_induct_rule = wf_induct [rule_format, consumes 1, case_names less, induct set: wf]
lemmas wfP_induct_rule = wf_induct_rule [to_pred, induct set: wfP]
lemma wf_on_iff_wf: "wf_on A r ⟷ wf {(x, y) ∈ r. x ∈ A ∧ y ∈ A}"
proof (rule iffI)
assume wf: "wf_on A r"
show "wf {(x, y) ∈ r. x ∈ A ∧ y ∈ A}"
unfolding wf_def
proof (intro allI impI ballI)
fix P x
assume IH: "∀x. (∀y. (y, x) ∈ {(x, y). (x, y) ∈ r ∧ x ∈ A ∧ y ∈ A} ⟶ P y) ⟶ P x"
show "P x"
proof (cases "x ∈ A")
case True
show ?thesis
using wf
proof (induction x rule: wf_on_induct)
case in_set
thus ?case
using True .
next
case (less x)
thus ?case
by (auto intro: IH[rule_format])
qed
next
case False
then show ?thesis
by (auto intro: IH[rule_format])
qed
qed
next
assume wf: "wf {(x, y). (x, y) ∈ r ∧ x ∈ A ∧ y ∈ A}"
show "wf_on A r"
unfolding wf_on_def
proof (intro allI impI ballI)
fix P x
assume IH: "∀x∈A. (∀y∈A. (y, x) ∈ r ⟶ P y) ⟶ P x" and "x ∈ A"
show "P x"
using wf ‹x ∈ A›
proof (induction x rule: wf_on_induct)
case in_set
show ?case
by simp
next
case (less y)
hence "⋀z. (z, y) ∈ r ⟹ z ∈ A ⟹ P z"
by simp
thus ?case
using IH[rule_format, OF ‹y ∈ A›] by simp
qed
qed
qed
subsection ‹Introduction Rules›
lemma wfUNIVI: "(⋀P x. (∀x. (∀y. (y, x) ∈ r ⟶ P y) ⟶ P x) ⟹ P x) ⟹ wf r"
unfolding wf_def by blast
lemmas wfPUNIVI = wfUNIVI [to_pred]
text ‹Restriction to domain ‹A› and range ‹B›.
If ‹r› is well-founded over their intersection, then ‹wf r›.›
lemma wfI:
assumes "r ⊆ A × B"
and "⋀x P. ⟦∀x. (∀y. (y, x) ∈ r ⟶ P y) ⟶ P x; x ∈ A; x ∈ B⟧ ⟹ P x"
shows "wf r"
using assms unfolding wf_def by blast
subsection ‹Ordering Properties›
lemma wf_not_sym: "wf r ⟹ (a, x) ∈ r ⟹ (x, a) ∉ r"
by (induct a arbitrary: x set: wf) blast
lemma wf_asym:
assumes "wf r" "(a, x) ∈ r"
obtains "(x, a) ∉ r"
by (drule wf_not_sym[OF assms])
lemma wf_imp_asym: "wf r ⟹ asym r"
by (auto intro: asymI elim: wf_asym)
lemma wfP_imp_asymp: "wfP r ⟹ asymp r"
by (rule wf_imp_asym[to_pred])
lemma wf_not_refl [simp]: "wf r ⟹ (a, a) ∉ r"
by (blast elim: wf_asym)
lemma wf_irrefl:
assumes "wf r"
obtains "(a, a) ∉ r"
by (drule wf_not_refl[OF assms])
lemma wf_imp_irrefl:
assumes "wf r" shows "irrefl r"
using wf_irrefl [OF assms] by (auto simp add: irrefl_def)
lemma wfP_imp_irreflp: "wfP r ⟹ irreflp r"
by (rule wf_imp_irrefl[to_pred])
lemma wf_wellorderI:
assumes wf: "wf {(x::'a::ord, y). x < y}"
and lin: "OFCLASS('a::ord, linorder_class)"
shows "OFCLASS('a::ord, wellorder_class)"
apply (rule wellorder_class.intro [OF lin])
apply (simp add: wellorder_class.intro class.wellorder_axioms.intro wf_induct_rule [OF wf])
done
lemma (in wellorder) wf: "wf {(x, y). x < y}"
unfolding wf_def by (blast intro: less_induct)
lemma (in wellorder) wfP_less[simp]: "wfP (<)"
by (simp add: wf wfP_def)
lemma (in wellorder) wfp_on_less[simp]: "wfp_on A (<)"
unfolding wfp_on_def
proof (intro allI impI ballI)
fix P x
assume hyps: "∀x∈A. (∀y∈A. y < x ⟶ P y) ⟶ P x"
show "x ∈ A ⟹ P x"
proof (induction x rule: less_induct)
case (less x)
show ?case
proof (rule hyps[rule_format])
show "x ∈ A"
using ‹x ∈ A› .
next
show "⋀y. y ∈ A ⟹ y < x ⟹ P y"
using less.IH .
qed
qed
qed
subsection ‹Basic Results›
text ‹Point-free characterization of well-foundedness›
lemma wf_onE_pf:
assumes wf: "wf_on A r" and "B ⊆ A" and "B ⊆ r `` B"
shows "B = {}"
proof -
have "x ∉ B" if "x ∈ A" for x
using wf
proof (induction x rule: wf_on_induct)
case in_set
show ?case
using that .
next
case (less x)
have "x ∉ r `` B"
using less.IH ‹B ⊆ A› by blast
thus ?case
using ‹B ⊆ r `` B› by blast
qed
with ‹B ⊆ A› show ?thesis
by blast
qed
lemma wfE_pf: "wf R ⟹ A ⊆ R `` A ⟹ A = {}"
using wf_onE_pf[of UNIV, simplified] .
lemma wf_onI_pf:
assumes "⋀B. B ⊆ A ⟹ B ⊆ R `` B ⟹ B = {}"
shows "wf_on A R"
unfolding wf_on_def
proof (intro allI impI ballI)
fix P :: "'a ⇒ bool" and x :: 'a
let ?B = "{x ∈ A. ¬ P x}"
assume "∀x∈A. (∀y∈A. (y, x) ∈ R ⟶ P y) ⟶ P x"
hence "?B ⊆ R `` ?B" by blast
hence "{x ∈ A. ¬ P x} = {}"
using assms(1)[of ?B] by simp
moreover assume "x ∈ A"
ultimately show "P x"
by simp
qed
lemma wfI_pf: "(⋀A. A ⊆ R `` A ⟹ A = {}) ⟹ wf R"
using wf_onI_pf[of UNIV, simplified] .
subsubsection ‹Minimal-element characterization of well-foundedness›
lemma wf_on_iff_ex_minimal: "wf_on A R ⟷ (∀B ⊆ A. B ≠ {} ⟶ (∃z ∈ B. ∀y. (y, z) ∈ R ⟶ y ∉ B))"
proof (intro iffI allI impI)
fix B
assume "wf_on A R" and "B ⊆ A" and "B ≠ {}"
show "∃z ∈ B. ∀y. (y, z) ∈ R ⟶ y ∉ B"
using wf_onE_pf[OF ‹wf_on A R› ‹B ⊆ A›] ‹B ≠ {}› by blast
next
assume ex_min: "∀B⊆A. B ≠ {} ⟶ (∃z∈B. ∀y. (y, z) ∈ R ⟶ y ∉ B)"
show "wf_on A R "
proof (rule wf_onI_pf)
fix B
assume "B ⊆ A" and "B ⊆ R `` B"
have False if "B ≠ {}"
using ex_min[rule_format, OF ‹B ⊆ A› ‹B ≠ {}›]
using ‹B ⊆ R `` B› by blast
thus "B = {}"
by blast
qed
qed
lemma wf_iff_ex_minimal: "wf R ⟷ (∀B. B ≠ {} ⟶ (∃z ∈ B. ∀y. (y, z) ∈ R ⟶ y ∉ B))"
using wf_on_iff_ex_minimal[of UNIV, simplified] .
lemma wfp_on_iff_ex_minimal: "wfp_on A R ⟷ (∀B ⊆ A. B ≠ {} ⟶ (∃z ∈ B. ∀y. R y z ⟶ y ∉ B))"
using wf_on_iff_ex_minimal[of A, to_pred] by simp
lemma wfp_iff_ex_minimal: "wfp R ⟷ (∀B. B ≠ {} ⟶ (∃z ∈ B. ∀y. R y z ⟶ y ∉ B))"
using wfp_on_iff_ex_minimal[of UNIV, simplified] .
lemma wfE_min:
assumes wf: "wf R" and Q: "x ∈ Q"
obtains z where "z ∈ Q" "⋀y. (y, z) ∈ R ⟹ y ∉ Q"
using Q wfE_pf[OF wf, of Q] by blast
lemma wfE_min':
"wf R ⟹ Q ≠ {} ⟹ (⋀z. z ∈ Q ⟹ (⋀y. (y, z) ∈ R ⟹ y ∉ Q) ⟹ thesis) ⟹ thesis"
using wfE_min[of R _ Q] by blast
lemma wfI_min:
assumes a: "⋀x Q. x ∈ Q ⟹ ∃z∈Q. ∀y. (y, z) ∈ R ⟶ y ∉ Q"
shows "wf R"
proof (rule wfI_pf)
fix A
assume b: "A ⊆ R `` A"
have False if "x ∈ A" for x
using a[OF that] b by blast
then show "A = {}" by blast
qed
lemma wf_eq_minimal: "wf r ⟷ (∀Q x. x ∈ Q ⟶ (∃z∈Q. ∀y. (y, z) ∈ r ⟶ y ∉ Q))"
unfolding wf_iff_ex_minimal by blast
lemmas wfP_eq_minimal = wf_eq_minimal [to_pred]
subsubsection ‹Antimonotonicity›
lemma wf_on_antimono_strong:
assumes "wf_on B r" and "A ⊆ B" and "(⋀x y. x ∈ A ⟹ y ∈ A ⟹ (x, y) ∈ q ⟹ (x, y) ∈ r)"
shows "wf_on A q"
unfolding wf_on_iff_ex_minimal
proof (intro allI impI)
fix AA assume "AA ⊆ A" and "AA ≠ {}"
hence "∃z∈AA. ∀y. (y, z) ∈ r ⟶ y ∉ AA"
using ‹wf_on B r› ‹A ⊆ B›
by (simp add: wf_on_iff_ex_minimal)
then show "∃z∈AA. ∀y. (y, z) ∈ q ⟶ y ∉ AA"
using ‹AA ⊆ A› assms(3) by blast
qed
lemma wfp_on_antimono_strong:
"wfp_on B R ⟹ A ⊆ B ⟹ (⋀x y. x ∈ A ⟹ y ∈ A ⟹ Q x y ⟹ R x y) ⟹ wfp_on A Q"
using wf_on_antimono_strong[of B _ A, to_pred] .
lemma wf_on_antimono: "A ⊆ B ⟹ q ⊆ r ⟹ wf_on B r ≤ wf_on A q"
using wf_on_antimono_strong[of B r A q] by auto
lemma wfp_on_antimono: "A ⊆ B ⟹ Q ≤ R ⟹ wfp_on B R ≤ wfp_on A Q"
using wfp_on_antimono_strong[of B R A Q] by auto
lemma wf_on_subset: "wf_on B r ⟹ A ⊆ B ⟹ wf_on A r"
using wf_on_antimono_strong .
lemma wfp_on_subset: "wfp_on B R ⟹ A ⊆ B ⟹ wfp_on A R"
using wfp_on_antimono_strong .
subsubsection ‹Well-foundedness of transitive closure›
lemma wf_trancl:
assumes "wf r"
shows "wf (r⇧+)"
proof -
have "P x" if induct_step: "⋀x. (⋀y. (y, x) ∈ r⇧+ ⟹ P y) ⟹ P x" for P x
proof (rule induct_step)
show "P y" if "(y, x) ∈ r⇧+" for y
using ‹wf r› and that
proof (induct x arbitrary: y)
case (less x)
note hyp = ‹⋀x' y'. (x', x) ∈ r ⟹ (y', x') ∈ r⇧+ ⟹ P y'›
from ‹(y, x) ∈ r⇧+› show "P y"
proof cases
case base
show "P y"
proof (rule induct_step)
fix y'
assume "(y', y) ∈ r⇧+"
with ‹(y, x) ∈ r› show "P y'"
by (rule hyp [of y y'])
qed
next
case step
then obtain x' where "(x', x) ∈ r" and "(y, x') ∈ r⇧+"
by simp
then show "P y" by (rule hyp [of x' y])
qed
qed
qed
then show ?thesis unfolding wf_def by blast
qed
lemmas wfP_trancl = wf_trancl [to_pred]
lemma wf_converse_trancl: "wf (r¯) ⟹ wf ((r⇧+)¯)"
apply (subst trancl_converse [symmetric])
apply (erule wf_trancl)
done
text ‹Well-foundedness of subsets›
lemma wf_subset: "wf r ⟹ p ⊆ r ⟹ wf p"
by (simp add: wf_eq_minimal) fast
lemmas wfP_subset = wf_subset [to_pred]
text ‹Well-foundedness of the empty relation›
lemma wf_empty [iff]: "wf {}"
by (simp add: wf_def)
lemma wfP_empty [iff]: "wfP (λx y. False)"
proof -
have "wfP bot"
by (fact wf_empty[to_pred bot_empty_eq2])
then show ?thesis
by (simp add: bot_fun_def)
qed
lemma wf_Int1: "wf r ⟹ wf (r ∩ r')"
by (erule wf_subset) (rule Int_lower1)
lemma wf_Int2: "wf r ⟹ wf (r' ∩ r)"
by (erule wf_subset) (rule Int_lower2)
text ‹Exponentiation.›
lemma wf_exp:
assumes "wf (R ^^ n)"
shows "wf R"
proof (rule wfI_pf)
fix A assume "A ⊆ R `` A"
then have "A ⊆ (R ^^ n) `` A"
by (induct n) force+
with ‹wf (R ^^ n)› show "A = {}"
by (rule wfE_pf)
qed
text ‹Well-foundedness of ‹insert›.›
lemma wf_insert [iff]: "wf (insert (y,x) r) ⟷ wf r ∧ (x,y) ∉ r⇧*" (is "?lhs = ?rhs")
proof
assume ?lhs then show ?rhs
by (blast elim: wf_trancl [THEN wf_irrefl]
intro: rtrancl_into_trancl1 wf_subset rtrancl_mono [THEN subsetD])
next
assume R: ?rhs
then have R': "Q ≠ {} ⟹ (∃z∈Q. ∀y. (y, z) ∈ r ⟶ y ∉ Q)" for Q
by (auto simp: wf_eq_minimal)
show ?lhs
unfolding wf_eq_minimal
proof clarify
fix Q :: "'a set" and q
assume "q ∈ Q"
then obtain a where "a ∈ Q" and a: "⋀y. (y, a) ∈ r ⟹ y ∉ Q"
using R by (auto simp: wf_eq_minimal)
show "∃z∈Q. ∀y'. (y', z) ∈ insert (y, x) r ⟶ y' ∉ Q"
proof (cases "a=x")
case True
show ?thesis
proof (cases "y ∈ Q")
case True
then obtain z where "z ∈ Q" "(z, y) ∈ r⇧*"
"⋀z'. (z', z) ∈ r ⟶ z' ∈ Q ⟶ (z', y) ∉ r⇧*"
using R' [of "{z ∈ Q. (z,y) ∈ r⇧*}"] by auto
then have "∀y'. (y', z) ∈ insert (y, x) r ⟶ y' ∉ Q"
using R by(blast intro: rtrancl_trans)+
then show ?thesis
by (rule bexI) fact
next
case False
then show ?thesis
using a ‹a ∈ Q› by blast
qed
next
case False
with a ‹a ∈ Q› show ?thesis
by blast
qed
qed
qed
subsubsection ‹Well-foundedness of image›
lemma wf_map_prod_image_Dom_Ran:
fixes r:: "('a × 'a) set"
and f:: "'a ⇒ 'b"
assumes wf_r: "wf r"
and inj: "⋀ a a'. a ∈ Domain r ⟹ a' ∈ Range r ⟹ f a = f a' ⟹ a = a'"
shows "wf (map_prod f f ` r)"
proof (unfold wf_eq_minimal, clarify)
fix B :: "'b set" and b::"'b"
assume "b ∈ B"
define A where "A = f -` B ∩ Domain r"
show "∃z∈B. ∀y. (y, z) ∈ map_prod f f ` r ⟶ y ∉ B"
proof (cases "A = {}")
case False
then obtain a0 where "a0 ∈ A" and "∀a. (a, a0) ∈ r ⟶ a ∉ A"
using wfE_min[OF wf_r] by auto
thus ?thesis
using inj unfolding A_def
by (intro bexI[of _ "f a0"]) auto
qed (use ‹b ∈ B› in ‹unfold A_def, auto›)
qed
lemma wf_map_prod_image: "wf r ⟹ inj f ⟹ wf (map_prod f f ` r)"
by(rule wf_map_prod_image_Dom_Ran) (auto dest: inj_onD)
lemma wfp_on_image: "wfp_on (f ` A) R ⟷ wfp_on A (λa b. R (f a) (f b))"
proof (rule iffI)
assume hyp: "wfp_on (f ` A) R"
show "wfp_on A (λa b. R (f a) (f b))"
unfolding wfp_on_iff_ex_minimal
proof (intro allI impI)
fix B
assume "B ⊆ A" and "B ≠ {}"
hence "f ` B ⊆ f ` A" and "f ` B ≠ {}"
unfolding atomize_conj image_is_empty
using image_mono by iprover
hence "∃z∈f ` B. ∀y. R y z ⟶ y ∉ f ` B"
using hyp[unfolded wfp_on_iff_ex_minimal, rule_format] by iprover
then obtain fz where "fz ∈ f ` B" and fz_max: "∀y. R y fz ⟶ y ∉ f ` B" ..
obtain z where "z ∈ B" and "fz = f z"
using ‹fz ∈ f ` B› unfolding image_iff ..
show "∃z∈B. ∀y. R (f y) (f z) ⟶ y ∉ B"
proof (intro bexI allI impI)
show "z ∈ B"
using ‹z ∈ B› .
next
fix y assume "R (f y) (f z)"
hence "f y ∉ f ` B"
using fz_max ‹fz = f z› by iprover
thus "y ∉ B"
by (rule contrapos_nn) (rule imageI)
qed
qed
next
assume hyp: "wfp_on A (λa b. R (f a) (f b))"
show "wfp_on (f ` A) R"
unfolding wfp_on_iff_ex_minimal
proof (intro allI impI)
fix fA
assume "fA ⊆ f ` A" and "fA ≠ {}"
then obtain A' where "A' ⊆ A" and "A' ≠ {}" and "fA = f ` A'"
by (auto simp only: subset_image_iff)
obtain z where "z ∈ A'" and z_max: "∀y. R (f y) (f z) ⟶ y ∉ A'"
using hyp[unfolded wfp_on_iff_ex_minimal, rule_format, OF ‹A' ⊆ A› ‹A' ≠ {}›] by blast
show "∃z∈fA. ∀y. R y z ⟶ y ∉ fA"
proof (intro bexI allI impI)
show "f z ∈ fA"
unfolding ‹fA = f ` A'›
using imageI[OF ‹z ∈ A'›] .
next
show "⋀y. R y (f z) ⟹ y ∉ fA"
unfolding ‹fA = f ` A'›
using z_max by auto
qed
qed
qed
subsection ‹Well-Foundedness Results for Unions›
lemma wf_union_compatible:
assumes "wf R" "wf S"
assumes "R O S ⊆ R"
shows "wf (R ∪ S)"
proof (rule wfI_min)
fix x :: 'a and Q
let ?Q' = "{x ∈ Q. ∀y. (y, x) ∈ R ⟶ y ∉ Q}"
assume "x ∈ Q"
obtain a where "a ∈ ?Q'"
by (rule wfE_min [OF ‹wf R› ‹x ∈ Q›]) blast
with ‹wf S› obtain z where "z ∈ ?Q'" and zmin: "⋀y. (y, z) ∈ S ⟹ y ∉ ?Q'"
by (erule wfE_min)
have "y ∉ Q" if "(y, z) ∈ S" for y
proof
from that have "y ∉ ?Q'" by (rule zmin)
assume "y ∈ Q"
with ‹y ∉ ?Q'› obtain w where "(w, y) ∈ R" and "w ∈ Q" by auto
from ‹(w, y) ∈ R› ‹(y, z) ∈ S› have "(w, z) ∈ R O S" by (rule relcompI)
with ‹R O S ⊆ R› have "(w, z) ∈ R" ..
with ‹z ∈ ?Q'› have "w ∉ Q" by blast
with ‹w ∈ Q› show False by contradiction
qed
with ‹z ∈ ?Q'› show "∃z∈Q. ∀y. (y, z) ∈ R ∪ S ⟶ y ∉ Q" by blast
qed
text ‹Well-foundedness of indexed union with disjoint domains and ranges.›
lemma wf_UN:
assumes r: "⋀i. i ∈ I ⟹ wf (r i)"
and disj: "⋀i j. ⟦i ∈ I; j ∈ I; r i ≠ r j⟧ ⟹ Domain (r i) ∩ Range (r j) = {}"
shows "wf (⋃i∈I. r i)"
unfolding wf_eq_minimal
proof clarify
fix A and a :: "'b"
assume "a ∈ A"
show "∃z∈A. ∀y. (y, z) ∈ ⋃(r ` I) ⟶ y ∉ A"
proof (cases "∃i∈I. ∃a∈A. ∃b∈A. (b, a) ∈ r i")
case True
then obtain i b c where ibc: "i ∈ I" "b ∈ A" "c ∈ A" "(c,b) ∈ r i"
by blast
have ri: "⋀Q. Q ≠ {} ⟹ ∃z∈Q. ∀y. (y, z) ∈ r i ⟶ y ∉ Q"
using r [OF ‹i ∈ I›] unfolding wf_eq_minimal by auto
show ?thesis
using ri [of "{a. a ∈ A ∧ (∃b∈A. (b, a) ∈ r i) }"] ibc disj
by blast
next
case False
with ‹a ∈ A› show ?thesis
by blast
qed
qed
lemma wfP_SUP:
"∀i. wfP (r i) ⟹ ∀i j. r i ≠ r j ⟶ inf (Domainp (r i)) (Rangep (r j)) = bot ⟹
wfP (⨆(range r))"
by (rule wf_UN[to_pred]) simp_all
lemma wf_Union:
assumes "∀r∈R. wf r"
and "∀r∈R. ∀s∈R. r ≠ s ⟶ Domain r ∩ Range s = {}"
shows "wf (⋃R)"
using assms wf_UN[of R "λi. i"] by simp
text ‹
Intuition: We find an ‹R ∪ S›-min element of a nonempty subset ‹A› by case distinction.
▸ There is a step ‹a ─R→ b› with ‹a, b ∈ A›.
Pick an ‹R›-min element ‹z› of the (nonempty) set ‹{a∈A | ∃b∈A. a ─R→ b}›.
By definition, there is ‹z' ∈ A› s.t. ‹z ─R→ z'›. Because ‹z› is ‹R›-min in the
subset, ‹z'› must be ‹R›-min in ‹A›. Because ‹z'› has an ‹R›-predecessor, it cannot
have an ‹S›-successor and is thus ‹S›-min in ‹A› as well.
▸ There is no such step.
Pick an ‹S›-min element of ‹A›. In this case it must be an ‹R›-min
element of ‹A› as well.
›
lemma wf_Un: "wf r ⟹ wf s ⟹ Domain r ∩ Range s = {} ⟹ wf (r ∪ s)"
using wf_union_compatible[of s r]
by (auto simp: Un_ac)
lemma wf_union_merge: "wf (R ∪ S) = wf (R O R ∪ S O R ∪ S)"
(is "wf ?A = wf ?B")
proof
assume "wf ?A"
with wf_trancl have wfT: "wf (?A⇧+)" .
moreover have "?B ⊆ ?A⇧+"
by (subst trancl_unfold, subst trancl_unfold) blast
ultimately show "wf ?B" by (rule wf_subset)
next
assume "wf ?B"
show "wf ?A"
proof (rule wfI_min)
fix Q :: "'a set" and x
assume "x ∈ Q"
with ‹wf ?B› obtain z where "z ∈ Q" and "⋀y. (y, z) ∈ ?B ⟹ y ∉ Q"
by (erule wfE_min)
then have 1: "⋀y. (y, z) ∈ R O R ⟹ y ∉ Q"
and 2: "⋀y. (y, z) ∈ S O R ⟹ y ∉ Q"
and 3: "⋀y. (y, z) ∈ S ⟹ y ∉ Q"
by auto
show "∃z∈Q. ∀y. (y, z) ∈ ?A ⟶ y ∉ Q"
proof (cases "∀y. (y, z) ∈ R ⟶ y ∉ Q")
case True
with ‹z ∈ Q› 3 show ?thesis by blast
next
case False
then obtain z' where "z'∈Q" "(z', z) ∈ R" by blast
have "∀y. (y, z') ∈ ?A ⟶ y ∉ Q"
proof (intro allI impI)
fix y assume "(y, z') ∈ ?A"
then show "y ∉ Q"
proof
assume "(y, z') ∈ R"
then have "(y, z) ∈ R O R" using ‹(z', z) ∈ R› ..
with 1 show "y ∉ Q" .
next
assume "(y, z') ∈ S"
then have "(y, z) ∈ S O R" using ‹(z', z) ∈ R› ..
with 2 show "y ∉ Q" .
qed
qed
with ‹z' ∈ Q› show ?thesis ..
qed
qed
qed
lemma wf_comp_self: "wf R ⟷ wf (R O R)"
by (rule wf_union_merge [where S = "{}", simplified])
subsection ‹Well-Foundedness of Composition›
text ‹Bachmair and Dershowitz 1986, Lemma 2. [Provided by Tjark Weber]›
lemma qc_wf_relto_iff:
assumes "R O S ⊆ (R ∪ S)⇧* O R"
shows "wf (S⇧* O R O S⇧*) ⟷ wf R"
(is "wf ?S ⟷ _")
proof
show "wf R" if "wf ?S"
proof -
have "R ⊆ ?S" by auto
with wf_subset [of ?S] that show "wf R"
by auto
qed
next
show "wf ?S" if "wf R"
proof (rule wfI_pf)
fix A
assume A: "A ⊆ ?S `` A"
let ?X = "(R ∪ S)⇧* `` A"
have *: "R O (R ∪ S)⇧* ⊆ (R ∪ S)⇧* O R"
proof -
have "(x, z) ∈ (R ∪ S)⇧* O R" if "(y, z) ∈ (R ∪ S)⇧*" and "(x, y) ∈ R" for x y z
using that
proof (induct y z)
case rtrancl_refl
then show ?case by auto
next
case (rtrancl_into_rtrancl a b c)
then have "(x, c) ∈ ((R ∪ S)⇧* O (R ∪ S)⇧*) O R"
using assms by blast
then show ?case by simp
qed
then show ?thesis by auto
qed
then have "R O S⇧* ⊆ (R ∪ S)⇧* O R"
using rtrancl_Un_subset by blast
then have "?S ⊆ (R ∪ S)⇧* O (R ∪ S)⇧* O R"
by (simp add: relcomp_mono rtrancl_mono)
also have "… = (R ∪ S)⇧* O R"
by (simp add: O_assoc[symmetric])
finally have "?S O (R ∪ S)⇧* ⊆ (R ∪ S)⇧* O R O (R ∪ S)⇧*"
by (simp add: O_assoc[symmetric] relcomp_mono)
also have "… ⊆ (R ∪ S)⇧* O (R ∪ S)⇧* O R"
using * by (simp add: relcomp_mono)
finally have "?S O (R ∪ S)⇧* ⊆ (R ∪ S)⇧* O R"
by (simp add: O_assoc[symmetric])
then have "(?S O (R ∪ S)⇧*) `` A ⊆ ((R ∪ S)⇧* O R) `` A"
by (simp add: Image_mono)
moreover have "?X ⊆ (?S O (R ∪ S)⇧*) `` A"
using A by (auto simp: relcomp_Image)
ultimately have "?X ⊆ R `` ?X"
by (auto simp: relcomp_Image)
then have "?X = {}"
using ‹wf R› by (simp add: wfE_pf)
moreover have "A ⊆ ?X" by auto
ultimately show "A = {}" by simp
qed
qed
corollary wf_relcomp_compatible:
assumes "wf R" and "R O S ⊆ S O R"
shows "wf (S O R)"
proof -
have "R O S ⊆ (R ∪ S)⇧* O R"
using assms by blast
then have "wf (S⇧* O R O S⇧*)"
by (simp add: assms qc_wf_relto_iff)
then show ?thesis
by (rule Wellfounded.wf_subset) blast
qed
subsection ‹Acyclic relations›
lemma wf_acyclic: "wf r ⟹ acyclic r"
by (simp add: acyclic_def) (blast elim: wf_trancl [THEN wf_irrefl])
lemmas wfP_acyclicP = wf_acyclic [to_pred]
subsubsection ‹Wellfoundedness of finite acyclic relations›
lemma finite_acyclic_wf:
assumes "finite r" "acyclic r" shows "wf r"
using assms
proof (induction r rule: finite_induct)
case (insert x r)
then show ?case
by (cases x) simp
qed simp
lemma finite_acyclic_wf_converse: "finite r ⟹ acyclic r ⟹ wf (r¯)"
apply (erule finite_converse [THEN iffD2, THEN finite_acyclic_wf])
apply (erule acyclic_converse [THEN iffD2])
done
text ‹
Observe that the converse of an irreflexive, transitive,
and finite relation is again well-founded. Thus, we may
employ it for well-founded induction.
›
lemma wf_converse:
assumes "irrefl r" and "trans r" and "finite r"
shows "wf (r¯)"
proof -
have "acyclic r"
using ‹irrefl r› and ‹trans r›
by (simp add: irrefl_def acyclic_irrefl)
with ‹finite r› show ?thesis
by (rule finite_acyclic_wf_converse)
qed
lemma wf_iff_acyclic_if_finite: "finite r ⟹ wf r = acyclic r"
by (blast intro: finite_acyclic_wf wf_acyclic)
subsection ‹\<^typ>‹nat› is well-founded›
lemma less_nat_rel: "(<) = (λm n. n = Suc m)⇧+⇧+"
proof (rule ext, rule ext, rule iffI)
fix n m :: nat
show "(λm n. n = Suc m)⇧+⇧+ m n" if "m < n"
using that
proof (induct n)
case 0
then show ?case by auto
next
case (Suc n)
then show ?case
by (auto simp add: less_Suc_eq_le le_less intro: tranclp.trancl_into_trancl)
qed
show "m < n" if "(λm n. n = Suc m)⇧+⇧+ m n"
using that by (induct n) (simp_all add: less_Suc_eq_le reflexive le_less)
qed
definition pred_nat :: "(nat × nat) set"
where "pred_nat = {(m, n). n = Suc m}"
definition less_than :: "(nat × nat) set"
where "less_than = pred_nat⇧+"
lemma less_eq: "(m, n) ∈ pred_nat⇧+ ⟷ m < n"
unfolding less_nat_rel pred_nat_def trancl_def by simp
lemma pred_nat_trancl_eq_le: "(m, n) ∈ pred_nat⇧* ⟷ m ≤ n"
unfolding less_eq rtrancl_eq_or_trancl by auto
lemma wf_pred_nat: "wf pred_nat"
unfolding wf_def
proof clarify
fix P x
assume "∀x'. (∀y. (y, x') ∈ pred_nat ⟶ P y) ⟶ P x'"
then show "P x"
unfolding pred_nat_def by (induction x) blast+
qed
lemma wf_less_than [iff]: "wf less_than"
by (simp add: less_than_def wf_pred_nat [THEN wf_trancl])
lemma trans_less_than [iff]: "trans less_than"
by (simp add: less_than_def)
lemma less_than_iff [iff]: "((x,y) ∈ less_than) = (x<y)"
by (simp add: less_than_def less_eq)
lemma irrefl_less_than: "irrefl less_than"
using irrefl_def by blast
lemma asym_less_than: "asym less_than"
by (rule asymI) simp
lemma total_less_than: "total less_than" and total_on_less_than [simp]: "total_on A less_than"
using total_on_def by force+
lemma wf_less: "wf {(x, y::nat). x < y}"
by (rule Wellfounded.wellorder_class.wf)
subsection ‹Accessible Part›
text ‹
Inductive definition of the accessible part ‹acc r› of a
relation; see also \<^cite>‹"paulin-tlca"›.
›
inductive_set acc :: "('a × 'a) set ⇒ 'a set" for r :: "('a × 'a) set"
where accI: "(⋀y. (y, x) ∈ r ⟹ y ∈ acc r) ⟹ x ∈ acc r"
abbreviation termip :: "('a ⇒ 'a ⇒ bool) ⇒ 'a ⇒ bool"
where "termip r ≡ accp (r¯¯)"
abbreviation termi :: "('a × 'a) set ⇒ 'a set"
where "termi r ≡ acc (r¯)"
lemmas accpI = accp.accI
lemma accp_eq_acc [code]: "accp r = (λx. x ∈ Wellfounded.acc {(x, y). r x y})"
by (simp add: acc_def)
text ‹Induction rules›
theorem accp_induct:
assumes major: "accp r a"
assumes hyp: "⋀x. accp r x ⟹ ∀y. r y x ⟶ P y ⟹ P x"
shows "P a"
apply (rule major [THEN accp.induct])
apply (rule hyp)
apply (rule accp.accI)
apply auto
done
lemmas accp_induct_rule = accp_induct [rule_format, induct set: accp]
theorem accp_downward: "accp r b ⟹ r a b ⟹ accp r a"
by (cases rule: accp.cases)
lemma not_accp_down:
assumes na: "¬ accp R x"
obtains z where "R z x" and "¬ accp R z"
proof -
assume a: "⋀z. R z x ⟹ ¬ accp R z ⟹ thesis"
show thesis
proof (cases "∀z. R z x ⟶ accp R z")
case True
then have "⋀z. R z x ⟹ accp R z" by auto
then have "accp R x" by (rule accp.accI)
with na show thesis ..
next
case False then obtain z where "R z x" and "¬ accp R z"
by auto
with a show thesis .
qed
qed
lemma accp_downwards_aux: "r⇧*⇧* b a ⟹ accp r a ⟶ accp r b"
by (erule rtranclp_induct) (blast dest: accp_downward)+
theorem accp_downwards: "accp r a ⟹ r⇧*⇧* b a ⟹ accp r b"
by (blast dest: accp_downwards_aux)
theorem accp_wfPI: "∀x. accp r x ⟹ wfP r"
proof (rule wfPUNIVI)
fix P x
assume "∀x. accp r x" "∀x. (∀y. r y x ⟶ P y) ⟶ P x"
then show "P x"
using accp_induct[where P = P] by blast
qed
theorem accp_wfPD: "wfP r ⟹ accp r x"
apply (erule wfP_induct_rule)
apply (rule accp.accI)
apply blast
done
theorem wfP_accp_iff: "wfP r = (∀x. accp r x)"
by (blast intro: accp_wfPI dest: accp_wfPD)
text ‹Smaller relations have bigger accessible parts:›
lemma accp_subset:
assumes "R1 ≤ R2"
shows "accp R2 ≤ accp R1"
proof (rule predicate1I)
fix x
assume "accp R2 x"
then show "accp R1 x"
proof (induct x)
fix x
assume "⋀y. R2 y x ⟹ accp R1 y"
with assms show "accp R1 x"
by (blast intro: accp.accI)
qed
qed
text ‹This is a generalized induction theorem that works on
subsets of the accessible part.›
lemma accp_subset_induct:
assumes subset: "D ≤ accp R"
and dcl: "⋀x z. D x ⟹ R z x ⟹ D z"
and "D x"
and istep: "⋀x. D x ⟹ (⋀z. R z x ⟹ P z) ⟹ P x"
shows "P x"
proof -
from subset and ‹D x›
have "accp R x" ..
then show "P x" using ‹D x›
proof (induct x)
fix x
assume "D x" and "⋀y. R y x ⟹ D y ⟹ P y"
with dcl and istep show "P x" by blast
qed
qed
text ‹Set versions of the above theorems›
lemmas acc_induct = accp_induct [to_set]
lemmas acc_induct_rule = acc_induct [rule_format, induct set: acc]
lemmas acc_downward = accp_downward [to_set]
lemmas not_acc_down = not_accp_down [to_set]
lemmas acc_downwards_aux = accp_downwards_aux [to_set]
lemmas acc_downwards = accp_downwards [to_set]
lemmas acc_wfI = accp_wfPI [to_set]
lemmas acc_wfD = accp_wfPD [to_set]
lemmas wf_acc_iff = wfP_accp_iff [to_set]
lemmas acc_subset = accp_subset [to_set]
lemmas acc_subset_induct = accp_subset_induct [to_set]
subsection ‹Tools for building wellfounded relations›
text ‹Inverse Image›
lemma wf_inv_image [simp,intro!]:
fixes f :: "'a ⇒ 'b"
assumes "wf r"
shows "wf (inv_image r f)"
proof -
have "⋀x P. x ∈ P ⟹ ∃z∈P. ∀y. (f y, f z) ∈ r ⟶ y ∉ P"
proof -
fix P and x::'a
assume "x ∈ P"
then obtain w where w: "w ∈ {w. ∃x::'a. x ∈ P ∧ f x = w}"
by auto
have *: "⋀Q u. u ∈ Q ⟹ ∃z∈Q. ∀y. (y, z) ∈ r ⟶ y ∉ Q"
using assms by (auto simp add: wf_eq_minimal)
show "∃z∈P. ∀y. (f y, f z) ∈ r ⟶ y ∉ P"
using * [OF w] by auto
qed
then show ?thesis
by (clarsimp simp: inv_image_def wf_eq_minimal)
qed
lemma wfp_on_inv_imagep:
assumes wf: "wfp_on (f ` A) R"
shows "wfp_on A (inv_imagep R f)"
unfolding wfp_on_iff_ex_minimal
proof (intro allI impI)
fix B assume "B ⊆ A" and "B ≠ {}"
hence "∃z∈f ` B. ∀y. R y z ⟶ y ∉ f ` B"
using wf[unfolded wfp_on_iff_ex_minimal, rule_format, of "f ` B"] by blast
thus "∃z∈B. ∀y. inv_imagep R f y z ⟶ y ∉ B"
unfolding inv_imagep_def
by auto
qed
subsubsection ‹Conversion to a known well-founded relation›
lemma wfp_on_if_convertible_to_wfp_on:
assumes
wf: "wfp_on (f ` A) Q" and
convertible: "(⋀x y. x ∈ A ⟹ y ∈ A ⟹ R x y ⟹ Q (f x) (f y))"
shows "wfp_on A R"
unfolding wfp_on_iff_ex_minimal
proof (intro allI impI)
fix B assume "B ⊆ A" and "B ≠ {}"
moreover from wf have "wfp_on A (inv_imagep Q f)"
by (rule wfp_on_inv_imagep)
ultimately obtain y where "y ∈ B" and "⋀z. Q (f z) (f y) ⟹ z ∉ B"
unfolding wfp_on_iff_ex_minimal in_inv_imagep
by blast
thus "∃z ∈ B. ∀y. R y z ⟶ y ∉ B"
using ‹B ⊆ A› convertible by blast
qed
lemma wf_on_if_convertible_to_wf_on: "wf_on (f ` A) Q ⟹ (⋀x y. x ∈ A ⟹ y ∈ A ⟹ (x, y) ∈ R ⟹ (f x, f y) ∈ Q) ⟹ wf_on A R"
using wfp_on_if_convertible_to_wfp_on[to_set] .
lemma wf_if_convertible_to_wf:
fixes r :: "'a rel" and s :: "'b rel" and f :: "'a ⇒ 'b"
assumes "wf s" and convertible: "⋀x y. (x, y) ∈ r ⟹ (f x, f y) ∈ s"
shows "wf r"
proof (rule wf_on_if_convertible_to_wf_on)
show "wf_on (range f) s"
using wf_on_subset[OF ‹wf s› subset_UNIV] .
next
show "⋀x y. (x, y) ∈ r ⟹ (f x, f y) ∈ s"
using convertible .
qed
lemma wfP_if_convertible_to_wfP: "wfP S ⟹ (⋀x y. R x y ⟹ S (f x) (f y)) ⟹ wfP R"
using wf_if_convertible_to_wf[to_pred, of S R f] by simp
text ‹Converting to @{typ nat} is a very common special case that might be found more easily by
Sledgehammer.›
lemma wfP_if_convertible_to_nat:
fixes f :: "_ ⇒ nat"
shows "(⋀x y. R x y ⟹ f x < f y) ⟹ wfP R"
by (rule wfP_if_convertible_to_wfP[of "(<) :: nat ⇒ nat ⇒ bool", simplified])
subsubsection ‹Measure functions into \<^typ>‹nat››
definition measure :: "('a ⇒ nat) ⇒ ('a × 'a) set"
where "measure = inv_image less_than"
lemma in_measure[simp, code_unfold]: "(x, y) ∈ measure f ⟷ f x < f y"
by (simp add:measure_def)
lemma wf_measure [iff]: "wf (measure f)"
unfolding measure_def by (rule wf_less_than [THEN wf_inv_image])
lemma wf_if_measure: "(⋀x. P x ⟹ f(g x) < f x) ⟹ wf {(y,x). P x ∧ y = g x}"
for f :: "'a ⇒ nat"
using wf_measure[of f] unfolding measure_def inv_image_def less_than_def less_eq
by (rule wf_subset) auto
subsubsection ‹Lexicographic combinations›
definition lex_prod :: "('a ×'a) set ⇒ ('b × 'b) set ⇒ (('a × 'b) × ('a × 'b)) set"
(infixr "<*lex*>" 80)
where "ra <*lex*> rb = {((a, b), (a', b')). (a, a') ∈ ra ∨ a = a' ∧ (b, b') ∈ rb}"
lemma in_lex_prod[simp]: "((a, b), (a', b')) ∈ r <*lex*> s ⟷ (a, a') ∈ r ∨ a = a' ∧ (b, b') ∈ s"
by (auto simp:lex_prod_def)
lemma wf_lex_prod [intro!]:
assumes "wf ra" "wf rb"
shows "wf (ra <*lex*> rb)"
proof (rule wfI)
fix z :: "'a × 'b" and P
assume * [rule_format]: "∀u. (∀v. (v, u) ∈ ra <*lex*> rb ⟶ P v) ⟶ P u"
obtain x y where zeq: "z = (x,y)"
by fastforce
have "P(x,y)" using ‹wf ra›
proof (induction x arbitrary: y rule: wf_induct_rule)
case (less x)
note lessx = less
show ?case using ‹wf rb› less
proof (induction y rule: wf_induct_rule)
case (less y)
show ?case
by (force intro: * less.IH lessx)
qed
qed
then show "P z"
by (simp add: zeq)
qed auto
lemma refl_lex_prod[simp]: "refl r⇩B ⟹ refl (r⇩A <*lex*> r⇩B)"
by (auto intro!: reflI dest: refl_onD)
lemma irrefl_on_lex_prod[simp]:
"irrefl_on A r⇩A ⟹ irrefl_on B r⇩B ⟹ irrefl_on (A × B) (r⇩A <*lex*> r⇩B)"
by (auto intro!: irrefl_onI dest: irrefl_onD)
lemma irrefl_lex_prod[simp]: "irrefl r⇩A ⟹ irrefl r⇩B ⟹ irrefl (r⇩A <*lex*> r⇩B)"
by (rule irrefl_on_lex_prod[of UNIV _ UNIV, unfolded UNIV_Times_UNIV])
lemma sym_on_lex_prod[simp]:
"sym_on A r⇩A ⟹ sym_on B r⇩B ⟹ sym_on (A × B) (r⇩A <*lex*> r⇩B)"
by (auto intro!: sym_onI dest: sym_onD)
lemma sym_lex_prod[simp]:
"sym r⇩A ⟹ sym r⇩B ⟹ sym (r⇩A <*lex*> r⇩B)"
by (rule sym_on_lex_prod[of UNIV _ UNIV, unfolded UNIV_Times_UNIV])
lemma asym_on_lex_prod[simp]:
"asym_on A r⇩A ⟹ asym_on B r⇩B ⟹ asym_on (A × B) (r⇩A <*lex*> r⇩B)"
by (auto intro!: asym_onI dest: asym_onD)
lemma asym_lex_prod[simp]:
"asym r⇩A ⟹ asym r⇩B ⟹ asym (r⇩A <*lex*> r⇩B)"
by (rule asym_on_lex_prod[of UNIV _ UNIV, unfolded UNIV_Times_UNIV])
lemma trans_on_lex_prod[simp]:
assumes "trans_on A r⇩A" and "trans_on B r⇩B"
shows "trans_on (A × B) (r⇩A <*lex*> r⇩B)"
proof (rule trans_onI)
fix x y z
show "x ∈ A × B ⟹ y ∈ A × B ⟹ z ∈ A × B ⟹
(x, y) ∈ r⇩A <*lex*> r⇩B ⟹ (y, z) ∈ r⇩A <*lex*> r⇩B ⟹ (x, z) ∈ r⇩A <*lex*> r⇩B"
using trans_onD[OF ‹trans_on A r⇩A›, of "fst x" "fst y" "fst z"]
using trans_onD[OF ‹trans_on B r⇩B›, of "snd x" "snd y" "snd z"]
by auto
qed
lemma trans_lex_prod [simp,intro!]: "trans r⇩A ⟹ trans r⇩B ⟹ trans (r⇩A <*lex*> r⇩B)"
by (rule trans_on_lex_prod[of UNIV _ UNIV, unfolded UNIV_Times_UNIV])
lemma total_on_lex_prod[simp]:
"total_on A r⇩A ⟹ total_on B r⇩B ⟹ total_on (A × B) (r⇩A <*lex*> r⇩B)"
by (auto simp: total_on_def)
lemma total_lex_prod[simp]: "total r⇩A ⟹ total r⇩B ⟹ total (r⇩A <*lex*> r⇩B)"
by (rule total_on_lex_prod[of UNIV _ UNIV, unfolded UNIV_Times_UNIV])
text ‹lexicographic combinations with measure functions›
definition mlex_prod :: "('a ⇒ nat) ⇒ ('a × 'a) set ⇒ ('a × 'a) set" (infixr "<*mlex*>" 80)
where "f <*mlex*> R = inv_image (less_than <*lex*> R) (λx. (f x, x))"
lemma
wf_mlex: "wf R ⟹ wf (f <*mlex*> R)" and
mlex_less: "f x < f y ⟹ (x, y) ∈ f <*mlex*> R" and
mlex_leq: "f x ≤ f y ⟹ (x, y) ∈ R ⟹ (x, y) ∈ f <*mlex*> R" and
mlex_iff: "(x, y) ∈ f <*mlex*> R ⟷ f x < f y ∨ f x = f y ∧ (x, y) ∈ R"
by (auto simp: mlex_prod_def)
text ‹Proper subset relation on finite sets.›
definition finite_psubset :: "('a set × 'a set) set"
where "finite_psubset = {(A, B). A ⊂ B ∧ finite B}"
lemma wf_finite_psubset[simp]: "wf finite_psubset"
apply (unfold finite_psubset_def)
apply (rule wf_measure [THEN wf_subset])
apply (simp add: measure_def inv_image_def less_than_def less_eq)
apply (fast elim!: psubset_card_mono)
done
lemma trans_finite_psubset: "trans finite_psubset"
by (auto simp: finite_psubset_def less_le trans_def)
lemma in_finite_psubset[simp]: "(A, B) ∈ finite_psubset ⟷ A ⊂ B ∧ finite B"
unfolding finite_psubset_def by auto
text ‹max- and min-extension of order to finite sets›
inductive_set max_ext :: "('a × 'a) set ⇒ ('a set × 'a set) set"
for R :: "('a × 'a) set"
where max_extI[intro]:
"finite X ⟹ finite Y ⟹ Y ≠ {} ⟹ (⋀x. x ∈ X ⟹ ∃y∈Y. (x, y) ∈ R) ⟹ (X, Y) ∈ max_ext R"
lemma max_ext_wf:
assumes wf: "wf r"
shows "wf (max_ext r)"
proof (rule acc_wfI, intro allI)
show "M ∈ acc (max_ext r)" (is "_ ∈ ?W") for M
proof (induct M rule: infinite_finite_induct)
case empty
show ?case
by (rule accI) (auto elim: max_ext.cases)
next
case (insert a M)
from wf ‹M ∈ ?W› ‹finite M› show "insert a M ∈ ?W"
proof (induct arbitrary: M)
fix M a
assume "M ∈ ?W"
assume [intro]: "finite M"
assume hyp: "⋀b M. (b, a) ∈ r ⟹ M ∈ ?W ⟹ finite M ⟹ insert b M ∈ ?W"
have add_less: "M ∈ ?W ⟹ (⋀y. y ∈ N ⟹ (y, a) ∈ r) ⟹ N ∪ M ∈ ?W"
if "finite N" "finite M" for N M :: "'a set"
using that by (induct N arbitrary: M) (auto simp: hyp)
show "insert a M ∈ ?W"
proof (rule accI)
fix N
assume Nless: "(N, insert a M) ∈ max_ext r"
then have *: "⋀x. x ∈ N ⟹ (x, a) ∈ r ∨ (∃y ∈ M. (x, y) ∈ r)"
by (auto elim!: max_ext.cases)
let ?N1 = "{n ∈ N. (n, a) ∈ r}"
let ?N2 = "{n ∈ N. (n, a) ∉ r}"
have N: "?N1 ∪ ?N2 = N" by (rule set_eqI) auto
from Nless have "finite N" by (auto elim: max_ext.cases)
then have finites: "finite ?N1" "finite ?N2" by auto
have "?N2 ∈ ?W"
proof (cases "M = {}")
case [simp]: True
have Mw: "{} ∈ ?W" by (rule accI) (auto elim: max_ext.cases)
from * have "?N2 = {}" by auto
with Mw show "?N2 ∈ ?W" by (simp only:)
next
case False
from * finites have N2: "(?N2, M) ∈ max_ext r"
using max_extI[OF _ _ ‹M ≠ {}›, where ?X = ?N2] by auto
with ‹M ∈ ?W› show "?N2 ∈ ?W" by (rule acc_downward)
qed
with finites have "?N1 ∪ ?N2 ∈ ?W"
by (rule add_less) simp
then show "N ∈ ?W" by (simp only: N)
qed
qed
next
case infinite
show ?case
by (rule accI) (auto elim: max_ext.cases simp: infinite)
qed
qed
lemma max_ext_additive: "(A, B) ∈ max_ext R ⟹ (C, D) ∈ max_ext R ⟹ (A ∪ C, B ∪ D) ∈ max_ext R"
by (force elim!: max_ext.cases)
definition min_ext :: "('a × 'a) set ⇒ ('a set × 'a set) set"
where "min_ext r = {(X, Y) | X Y. X ≠ {} ∧ (∀y ∈ Y. (∃x ∈ X. (x, y) ∈ r))}"
lemma min_ext_wf:
assumes "wf r"
shows "wf (min_ext r)"
proof (rule wfI_min)
show "∃m ∈ Q. (∀n. (n, m) ∈ min_ext r ⟶ n ∉ Q)" if nonempty: "x ∈ Q"
for Q :: "'a set set" and x
proof (cases "Q = {{}}")
case True
then show ?thesis by (simp add: min_ext_def)
next
case False
with nonempty obtain e x where "x ∈ Q" "e ∈ x" by force
then have eU: "e ∈ ⋃Q" by auto
with ‹wf r›
obtain z where z: "z ∈ ⋃Q" "⋀y. (y, z) ∈ r ⟹ y ∉ ⋃Q"
by (erule wfE_min)
from z obtain m where "m ∈ Q" "z ∈ m" by auto
from ‹m ∈ Q› show ?thesis
proof (intro rev_bexI allI impI)
fix n
assume smaller: "(n, m) ∈ min_ext r"
with ‹z ∈ m› obtain y where "y ∈ n" "(y, z) ∈ r"
by (auto simp: min_ext_def)
with z(2) show "n ∉ Q" by auto
qed
qed
qed
subsubsection ‹Bounded increase must terminate›
lemma wf_bounded_measure:
fixes ub :: "'a ⇒ nat"
and f :: "'a ⇒ nat"
assumes "⋀a b. (b, a) ∈ r ⟹ ub b ≤ ub a ∧ ub a ≥ f b ∧ f b > f a"
shows "wf r"
by (rule wf_subset[OF wf_measure[of "λa. ub a - f a"]]) (auto dest: assms)
lemma wf_bounded_set:
fixes ub :: "'a ⇒ 'b set"
and f :: "'a ⇒ 'b set"
assumes "⋀a b. (b,a) ∈ r ⟹ finite (ub a) ∧ ub b ⊆ ub a ∧ ub a ⊇ f b ∧ f b ⊃ f a"
shows "wf r"
apply (rule wf_bounded_measure[of r "λa. card (ub a)" "λa. card (f a)"])
apply (drule assms)
apply (blast intro: card_mono finite_subset psubset_card_mono dest: psubset_eq[THEN iffD2])
done
lemma finite_subset_wf:
assumes "finite A"
shows "wf {(X, Y). X ⊂ Y ∧ Y ⊆ A}"
by (rule wf_subset[OF wf_finite_psubset[unfolded finite_psubset_def]])
(auto intro: finite_subset[OF _ assms])
hide_const (open) acc accp
subsection ‹Code Generation Setup›
text ‹Code equations with \<^const>‹wf› or \<^const>‹wfp› on the left-hand side are not supported by the
code generation module because of the \<^const>‹UNIV› hidden behind the abbreviations. To sidestep this
problem, we provide the following wrapper definitions and use @{attribute code_abbrev} to register
the definitions with the pre- and post-processors of the code generator.›
definition wf_code :: "('a × 'a) set ⇒ bool" where
[code_abbrev]: "wf_code r ⟷ wf r"
definition wfp_code :: "('a ⇒ 'a ⇒ bool) ⇒ bool" where
[code_abbrev]: "wfp_code R ⟷ wfp R"
end