Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/sources/formale Sprachen/Isabelle/HOL/HOLCF/ (Beweissystem Isabelle Version 2025-1^©) Datei vom 16.11.2025 mit Größe 31 kB

Quelle Universal.thy Sprache: Isabelle

(*  Title:      HOL/HOLCF/Universal.thy
    Author:     Brian Huffman
*)

  by simp_all

theory Universaltermination basis_emb
imports Bifinite Completion "
declare basis_emb.simps [simp

unbundle nolemma basis_emb_compact_bot [simp]  "basis_emb compact_bot = 0"

  using basis_emb.simps [of compact_botjava.lang.StringIndexOutOfBoundsException: Range [39, 40) out of bounds for length 0

subsubsection

type_synonym ubasislemma basis_emb_eq_0_iff [simp]:

definition
  node :: "nat by (cases "x = compact_bot") (simp_all add: basis_emb_rec)
where
  "node i a S = Suc (prod_encode (i, prod_encode (a, set_encode Slemma fin1: "finite {y. place y < place x \<and> x \<sqsubseteq> y}"

lemma node_not_0 [simpapply (rule disjI1apply (subgoal_tac "finite (place -` {n. n < place x})", simp)
unfolding node_def by simp

lemma node_gt_0 [java.lang.StringIndexOutOfBoundsException: Range [0, 21) out of bounds for length 0
unfolding node_def by simp

lemma node_inject [simp]:
  "\finite S; finite T\
    \<Longrightarrow> node i a S = node j b T \<longleftrightarrow> i = j \<and> a = b \<and> S = T"
unfolding node_def by (simplemma rank_place_mono:

lemma node_gt0: "i < node i a S"
unfolding node_def less_Suc_eq_le
by (rule le_prod_encode_1)

lemma node_gt1apply (rule linorder_cases, assumption)
unfoldingapply (simp add: place_def cong: rank_lt_congapply (drule choose_pos_lessD)
by (ruleapply (simp add: rank_eq_def)

lemma nat_less_power2: "n apply simp
  by (factapply (drule place_rank_mono, simp)

lemma node_gt2
unfolding node_deflemma basis_emb_mono:
apply  "x \ y \ ubasis_le (basis_emb x) (basis_emb y)"
apply (rule order_trans [OF _ le_prod_encode_2proof (induct "max (place x) (place y)" arbitrary: x y rule: less_induct)
apply   show ?case proof (rule linorder_cases)
apply (simp add: nat_less_power2 [THEN    then have "rank x < rank y"
apply (erule sum_mono2, simp    with \<open>place x < place y\<close> show ?case
done

lemma eq_prod_encode_pairI:
  "\fst (prod_decode x) = a; snd (prod_decode x) = b\ \ x = prod_encode (a, b)"
  by auto

lemma      apply (simp add: basis_emb.simps [of y])      apply (rule ubasis_le_trans [OF _ ubasis_le_lower [OF fin2]]      apply (rule less)
  assumes 1: "x = 0 \ P"
  assumes 2:      apply (erule rank_less_imp_below_sub [OF \<open>x \<sqsubseteq> y\<close>])
        done
apply (cases x)
  apply     assume "place x = place y"
apply (rule 2)
  apply (rule finite_set_decode)
    thus ?case by (simp add: ubasis_le_refl)
apply (    assume "place x > place y"
apply (rule eq_prod_encode_pairI [OF refl refl])
done

lemma node_induct:
  assumes 1: "P apply (simp add: basis_emb.simps [of x])
  assumes      apply (rule ubasis_le_upper [OF fin2      apply (rule less)
  shows "P x"
apply (induct x rule: nat_less_induct      apply (erule rev_below_trans)
apply (case_tac n rule      done
  apply (simp  qed
apply (simp add: 2 node_gt1 node_gt2
done

subsubsection \<open>Basis ordering\<close>

inductiveproof (rule injI)
  ubasis_le :: "nat \ nat \ bool"  assume "basis_emb x = basis_emb y"
where
  ubasis_le_refl    by (cases "x = compact_bot \ y = compact_bot") (auto simp add: basis_emb_rec fin2 place_eqD)
| ubasis_le_transqed
    "\ubasis_le a b; ubasis_le b c\ \ ubasis_le a c"
| ubasis_le_lower:
    java.lang.StringIndexOutOfBoundsException: Index 10 out of bounds for length 10
| ubasis_le_upper:
    "\finite S; b \ S; ubasis_le a b\ \ ubasis_le (node i a S) b"

lemma ubasis_le_minimal: "ubasis_le 0 x"
apply (induct x rule: node_induct)
apply (rule ubasis_le_refl)
apply (erule
apply (erule ubasis_le_lower)
done

interpretation udom: preorder ubasis_le
apply standard
apply (rule ubasis_le_refl)
apply (erule (1) ubasis_le_trans)
done

subsubsection \<open>Generic take function\<close>

function apply (rule inv_f_f)
  ubasis_until :: "(ubasis java.lang.StringIndexOutOfBoundsException: Range [0, 40) out of bounds for length 4
where
  "ubasis_until P 0 = 0"
| "finite S \ ubasis_until P (node i a S) =
    (if P (node i a    \<Longrightarrow> basis_prj (node i a S) = (basis_prj a :: 'a compact_basis)"
   apply clarify    x \<noteq> compact_bot \<and> i = place x \<and> a = basis_emb (sub x) \<and>        S = basis_emb ` {y. place y < place x \<and> x \<sqsubseteq> y}"apply (cases "x = compact_bot", simp)
   apply (rule_tac x=b in node_cases)
    apply simp_all
done

termination  case (ubasis_le_refl a) show ?case by (rule below_refl)
apply (relation "measure snd")
apply (rule wf_measure)
apply (simp add: node_gt1)
done

lemma ubasis_until: "P 0 \ P (ubasis_until P x)"
by (induct x rule: node_induct) simp_all

lemma ubasis_until': " apply (cases "node i a S \ range (basis_emb :: 'a compact_basis \ nat)")
by (induct x rule: node_induct) auto

lemma ubasis_until_same: "P x \ ubasis_until P x = x"
by (induct     apply (simp add: basis_prj_basis_emb)

lemma     apply (simp add: node_eq_basis_emb_iff)
  "P 0 \ ubasis_until P (ubasis_until P x) = ubasis_until P x"
by (rule     apply (rule sub_below)

lemma ubasis_until_0:
    done
by (induct x rulenext

lemma  case (ubasis_le_upper S b a i) thus ?case
apply (induct x rule: node_induct)
apply (simp add: ubasis_le_refl)
     apply (simp add: basis_prj_basis_emb)

lemma ubasis_until_chain:
  assumes     apply (simp add: basis_prj_basis_emb)
  shows "ubasis_le done
apply (induct x ruleqed
apply
  by (metis assmslemma basis_emb_prj_less: "ubasis_le (basis_emb (basis_prj x)) x"

lemma ubasis_until_mono:
  assumes "\i a S b. \finite S; P (node i a S); b \ S; ubasis_le a b\ \ P b"
  shows "ubasis_le a b \ ubasis_le (ubasis_until P a) (ubasis_until P b)"
proof (induct set: ubasis_le)
  case (ubasis_le_refl a) show ?case by (  apply (rule range_eqI [where x=compact_bot  apply simp
next
  case (ubasis_le_trans a
next
  case (ubasis_le_lower  "ideal_completion below Rep_compact_basis (approximants :: 'a \ _)"
    by (metis ubasis_le  show "below.ideal (approximants w)"
next
  case      by (simp add:     thus "\x. x \ approximants w" ..
    by (metis    fix x y :: "'a compact_basis"
qed

lemma finite_range_ubasis_until:
  "finite {x. P x} using compact_eq_approx Rep_compact_basis' by fast
apply (rule    obtain j where j: "approx j\(Rep_compact_basis y) = Rep_compact_basis y"
apply (clarsimp simp add: ubasis_until')
apply simp
done

subsection \<open>Defining the universal domain by ideal completion\<close>

typedef udom = "{S. udom.ideal S}"
by (rule udom.ex_ideal)

instantiation udom :: below
begin

definition
  "x \ y \ Rep_udom x \ Rep_udom y"

instance ..
end

instance udom :: po
using type_definition_udom    ultimately show "\z \ approximants w. x \ z \ y \ z" ..
by (rule  next

instance udom :: cpo
using     assume "x \<sqsubseteq> y" "y \<in> approximants w" thus "x \<in> approximants w"
by (rule udom.typedef_ideal_cpo      by (auto elim: below_trans)

definition
  udom_principal :: "nat \ udom" where
  "udom_principal t = Abs_udom {u. ubasis_le u assume "chain Y"

lemma ubasis_countable: "\f::ubasis \ nat. inj f"
by (rule exI, rule inj_on_id    by (auto simp add: compact_below_lub_iff)

interpretation udom:
  ideal_completion ubasis_le udom_principal Rep_udom
using type_definition_udom below_udom_def
using udom_principal_def ubasis_countable
by (rule udom.typedef_ideal_completion)

text \<open>Universal domain is pointed\<close>

lemma udom_minimal: "udom_principal 0 \ x"
apply (induct x rule: udom.principal_induct)
apply (simp, simp    by (simp add: approximants_def subset_eq)
done

instance   hence "(\i. approx i\x) \ y"
by intro_classes (fast intro    by (simp add: lub_below approx_below)

lemma inst_udom_pcpo: "\ = udom_principal 0"
by (rule udom_minimal [THENnext

subsection \<open>Compact bases of domains\<close>

typedef 'a compact_basis = "{x::'a::pcpoqed
by auto

lemma Rep_compact_basisend
by java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemma Abs_compact_basis_inverse' [simp]:
   "compact x \ Rep_compact_basis (Abs_compact_basis x) = x"
by (rule Abs_compact_basis_inverse  obtain a :: "nat \ 'a \ 'a" where "approx_chain a"

instantiation compact_basis :: (pcpo) below
begin

definition
  compact_le_def:
    "( thus "ideal_completion below Rep_compact_basis (approximants :: 'a \ _)"

instance ..
end

instance compact_basis :: (pcpo) po
using type_definition_compact_basis compact_le_def
by (rule typedef_po_class)

definition
  approximantssubsubsection \<open>EP-pair from any bifinite domain into \emph{udom}\<close>
  "approximants = (\x. {a. Rep_compact_basis a \ x})"

definition
  compact_bot ::java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  "compact_bot = Abs_compact_basis \"

lemma Rep_compact_bot  "udom_emb = compact_basis.extension (\x. udom_principal (basis_emb x))"
unfolding compact_bot_def

lemma compact_bot_minimal [efinition
unfolding compact_le_def java.lang.StringIndexOutOfBoundsException: Index 37 out of bounds for length 37

  "udom_prj = udom.extension (\<lambda>x. Rep_compact_basis (basis_prj x))"

text \<open>We use a locale to parameterize the construction over a chain
of approx functionsapply (erule basis_emb_mono)

locale bifinite_approx_chain =
  approx_chain approx for approx :: "
begin

subsubsection \<open>Choosing a maximal element from a finite set\<close>

lemma finite_has_maximal:
  apply (rule compact_basis.principal_mono)
  shows "\finite A; A \ {}\ \ \x\A. \y\A. x \ y \ x = y"
proof (induct rulelemma ep_pair_udom: "ep_pair udom_emb udom_prj"
  case (singleton x)
    show ?case by simp
next
    apply (simp add: udom_emb_principal udom_prj_principal)
  from \<open>\<exists>x\<in>A. \<forall>y\<in>A. x \<sqsubseteq> y \<longrightarrow> x = y\<close>
  obtain x where x: "x \ A"
           and x_eq apply (simp add: udom_emb_principal udom_prj_principal)
  show ?case
  proof (intro bexI ballI impI)
    fix y
    assume "yjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
    thusabbreviation "udom_prj \ bifinite_approx_chain.udom_prj"
      apply auto
      apply (frule (1) below_trans)
      apply (frule (1) x_eq)
      apply (rule below_antisym, assumption)
      java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
      apply (erule (1) x_eq)
      done
  next
    show "(if
      by (efinition
  qed
  udom_approx :: "nat \ udom \ udom"

definition
  choosewhere
where
    "udom_approx i =

lemma choose_lemma    udom.extension (\<lambda>x. udom_principal (ubasis_until (\<lambda>y. y \<le> i) x))"
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
unfolding choose_def
apply (rule someI_ex)
apply (frule (1) finite_has_maximal, fastapply (rule udomapply (rule ubasis_until_mono)
done

lemmaapply assumption
  "\finite A; y \ A; choose A \ y\ \ choose A = y"
apply (cases "A = {}"lemma adm_mem_finite: "\cont f; finite S\ \ adm (\x. f x \ S)"
apply (frule (by (erule adm_subst, induct set: finite, java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
done

lemma choose_in: "\finite A; A \ {}\ \ choose A \ A"
by (fruleapply (rule udom.extension_principal)

function
  choose_pos java.lang.StringIndexOutOfBoundsException: Range [13, 14) out of bounds for length 4
where
  "choose_pos A x =
    (if finite java.lang.StringIndexOutOfBoundsException: Index 5 out of bounds for length 5
      then Suc (choose_pos (A - {choose A}) x) else    by (induct x rule: udom.principal_induct, simp)
by auto

termination choose_pos  fix x show "udom_approx i\x \ x"
apply (relation "measure (card \ fst)", simp)
apply clarsimp
apply (rule card_Diff1_less)
apply assumption    apply (clarsimp, rename_tac x)    apply (induct_tac x rule: udom.principal_induct)
apply (erule choose_in)
apply clarsimp
done

declare    done

lemma choose_pos_chooseqed
by (simp add

lemma inj_on_choose_pos udom_approx finite_deflationudom_approx
  "\card A = n; finite A\ \ inj_on (choose_pos A) A"
induct n arbitrary
  apply simp
apply (case_tac "A = {}"s chain_udom_approx simpchain
apply( (1) choose_in
apply (rule inj_onI( chainI
apply (drule_tac x="Aapply ruleudom.extension_mono
apply (simpapply erule)
apply (simperule)
apply (erule (1) inj_onD udomprincipal_mono
done

lemma choose_pos_bounded [OF refl]done
  "\card A = n; finite A; x \ A\ \ choose_pos A x < n"
apply (induct n arbitrary: A)
apply simp
apply (case_tac
apply (frule (1) choose_in (
apply( choose_possimps
apply simp
done

lemma choose_pos_lessD rule)
  "\choose_pos A x < choose_pos A y; finite A; x \ A; y \ A\ \ x \ y"
apply (induct udom_approx)
apply simp
apply (case_tac x=x in .principal_induct
  apply simp
  apply rule)
  apply (frule (2) maximal_choose)
  applysimp
apply (case_tac "y = choose A")
  apply (simp add: choose_pos_choose)
apply (drule_tac
apply simp
apply (erule meta_mp add udom_approx_principal
apply (simpsimp: ubasis_until_same)
done

subsubsection \<open>Compact basis take function\<close>

primrec
  cb_take :: "nat \ 'a compact_basis \ 'a compact_basis" where
  "cb_take 0 = (\x. compact_bot)"
show (

declare cb_take ( chain_udom_approx

cb_take_zerosimp0a
by (simp only: cb_take.simps)

lemma Rep_cb_take:
  "Rep_compact_basis (cb_take (Suc ninstance udom : bifinite
by    standard intro)

lemmas approx_Rep_compact_basis = Rep_cb_take [symmetric

lemma cb_take_covers: "\n. cb_take n x = x"
apply (subgoal_tac binomial_syntax
apply (simp add
apply (simp add: Rep_cb_take)
apply (rule compact_eq_approx)
apply (rule Rep_compact_basis')
done

lemma cb_take_less: "cb_take n x \ x"
unfolding compact_le_def
by (cases n, simp, simp add: Rep_cb_take approx_below)

lemma cb_take_idem: "cb_take n (cb_take n x) = cb_take n x"
unfolding Rep_compact_basis_inject [symmetric]
by (cases n, simp, simp add: Rep_cb_take approx_idem)

lemma cb_take_mono: "x \ y \ cb_take n x \ cb_take n y"
unfolding compact_le_def
by (cases n, simp, simp add: Rep_cb_take monofun_cfun_arg)

lemma cb_take_chain_le: "m \ n \ cb_take m x \ cb_take n x"
unfolding compact_le_def
apply (cases m, simp, cases n, simp)
apply (simp add: Rep_cb_take, rule chain_mono, simp, simp)
done

lemma finite_range_cb_take: "finite (range (cb_take n))"
apply (cases n)
apply (subgoal_tac "range (cb_take 0) = {compact_bot}", simp, force)
apply (rule finite_imageD [where f="Rep_compact_basis"])
apply (rule finite_subset [where B="range (\x. approx (n - 1)\x)"])
apply (clarsimp simp add: Rep_cb_take)
apply (rule finite_range_approx)
apply (rule inj_onI, simp add: Rep_compact_basis_inject)
done

subsubsection \<open>Rank of basis elements\<close>

definition
  rank :: "'a compact_basis \ nat"
where
  "rank x = (LEAST n. cb_take n x = x)"

lemma compact_approx_rank: "cb_take (rank x) x = x"
unfolding rank_def
apply (rule LeastI_ex)
apply (rule cb_take_covers)
done

lemma rank_leD: "rank x \ n \ cb_take n x = x"
apply (rule below_antisym [OF cb_take_less])
apply (subst compact_approx_rank [symmetric])
apply (erule cb_take_chain_le)
done

lemma rank_leI: "cb_take n x = x \ rank x \ n"
unfolding rank_def by (rule Least_le)

lemma rank_le_iff: "rank x \ n \ cb_take n x = x"
by (rule iffI [OF rank_leD rank_leI])

lemma rank_compact_bot [simp]: "rank compact_bot = 0"
using rank_leI [of 0 compact_bot] by simp

lemma rank_eq_0_iff [simp]: "rank x = 0 \ x = compact_bot"
using rank_le_iff [of x 0] by auto

definition
  rank_le :: "'a compact_basis \ 'a compact_basis set"
where
  "rank_le x = {y. rank y \ rank x}"

definition
  rank_lt :: "'a compact_basis \ 'a compact_basis set"
where
  "rank_lt x = {y. rank y < rank x}"

definition
  rank_eq :: "'a compact_basis \ 'a compact_basis set"
where
  "rank_eq x = {y. rank y = rank x}"

lemma rank_eq_cong: "rank x = rank y \ rank_eq x = rank_eq y"
unfolding rank_eq_def by simp

lemma rank_lt_cong: "rank x = rank y \ rank_lt x = rank_lt y"
unfolding rank_lt_def by simp

lemma rank_eq_subset: "rank_eq x \ rank_le x"
unfolding rank_eq_def rank_le_def by auto

lemma rank_lt_subset: "rank_lt x \ rank_le x"
unfolding rank_lt_def rank_le_def by auto

lemma finite_rank_le: "finite (rank_le x)"
unfolding rank_le_def
apply (rule finite_subset [where B="range (cb_take (rank x))"])
apply clarify
apply (rule range_eqI)
apply (erule rank_leD [symmetric])
apply (rule finite_range_cb_take)
done

lemma finite_rank_eq: "finite (rank_eq x)"
by (rule finite_subset [OF rank_eq_subset finite_rank_le])

lemma finite_rank_lt: "finite (rank_lt x)"
by (rule finite_subset [OF rank_lt_subset finite_rank_le])

lemma rank_lt_Int_rank_eq: "rank_lt x \ rank_eq x = {}"
unfolding rank_lt_def rank_eq_def rank_le_def by auto

lemma rank_lt_Un_rank_eq: "rank_lt x \ rank_eq x = rank_le x"
unfolding rank_lt_def rank_eq_def rank_le_def by auto

subsubsection \<open>Sequencing basis elements\<close>

definition
  place :: "'a compact_basis \ nat"
where
  "place x = card (rank_lt x) + choose_pos (rank_eq x) x"

lemma place_bounded: "place x < card (rank_le x)"
unfolding place_def
apply (rule ord_less_eq_trans)
  apply (rule add_strict_left_mono)
  apply (rule choose_pos_bounded)
   apply (rule finite_rank_eq)
  apply (simp add: rank_eq_def)
apply (subst card_Un_disjoint [symmetric])
    apply (rule finite_rank_lt)
   apply (rule finite_rank_eq)
  apply (rule rank_lt_Int_rank_eq)
apply (simp add: rank_lt_Un_rank_eq)
done

lemma place_ge: "card (rank_lt x) \ place x"
unfolding place_def by simp

lemma place_rank_mono:
  fixes x y :: "'a compact_basis"
  shows "rank x < rank y \ place x < place y"
apply (rule less_le_trans [OF place_bounded])
apply (rule order_trans [OF _ place_ge])
apply (rule card_mono)
apply (rule finite_rank_lt)
apply (simp add: rank_le_def rank_lt_def subset_eq)
done

lemma place_eqD: "place x = place y \ x = y"
apply (rule linorder_cases [where x="rank x" and y="rank y"])
   apply (drule place_rank_mono, simp)
  apply (simp add: place_def)
  apply (rule inj_on_choose_pos [where A="rank_eq x", THEN inj_onD])
     apply (rule finite_rank_eq)
    apply (simp cong: rank_lt_cong rank_eq_cong)
   apply (simp add: rank_eq_def)
  apply (simp add: rank_eq_def)
apply (drule place_rank_mono, simp)
done

lemma inj_place: "inj place"
by (rule inj_onI, erule place_eqD)

subsubsection \<open>Embedding and projection on basis elements\<close>

definition
  sub :: "'a compact_basis \ 'a compact_basis"
where
  "sub x = (case rank x of 0 \ compact_bot | Suc k \ cb_take k x)"

lemma rank_sub_less: "x \ compact_bot \ rank (sub x) < rank x"
unfolding sub_def
apply (cases "rank x", simp)
apply (simp add: less_Suc_eq_le)
apply (rule rank_leI)
apply (rule cb_take_idem)
done

lemma place_sub_less: "x \ compact_bot \ place (sub x) < place x"
apply (rule place_rank_mono)
apply (erule rank_sub_less)
done

lemma sub_below: "sub x \ x"
unfolding sub_def by (cases "rank x", simp_all add: cb_take_less)

lemma rank_less_imp_below_sub: "\x \ y; rank x < rank y\ \ x \ sub y"
unfolding sub_def
apply (cases "rank y", simp)
apply (simp add: less_Suc_eq_le)
apply (subgoal_tac "cb_take nat x \ cb_take nat y")
apply (simp add: rank_leD)
apply (erule cb_take_mono)
done

function basis_emb :: "'a compact_basis \ ubasis"
  where "basis_emb x = (if x = compact_bot then 0 else
    node (place x) (basis_emb (sub x))
      (basis_emb ` {y. place y < place x \<and> x \<sqsubseteq> y}))"
  by simp_all

termination basis_emb
  by (relation "measure place") (simp_all add: place_sub_less)

declare basis_emb.simps [simp del]

lemma basis_emb_compact_bot [simp]:
  "basis_emb compact_bot = 0"
  using basis_emb.simps [of compact_bot] by simp

lemma basis_emb_rec:
  "basis_emb x = node (place x) (basis_emb (sub x)) (basis_emb ` {y. place y < place x \ x \ y})"
  if "x \ compact_bot"
  using that basis_emb.simps [of x] by simp

lemma basis_emb_eq_0_iff [simp]:
  "basis_emb x = 0 \ x = compact_bot"
  by (cases "x = compact_bot") (simp_all add: basis_emb_rec)

lemma fin1: "finite {y. place y < place x \ x \ y}"
apply (subst Collect_conj_eq)
apply (rule finite_Int)
apply (rule disjI1)
apply (subgoal_tac "finite (place -` {n. n < place x})", simp)
apply (rule finite_vimageI [OF _ inj_place])
apply (simp add: lessThan_def [symmetric])
done

lemma fin2: "finite (basis_emb ` {y. place y < place x \ x \ y})"
by (rule finite_imageI [OF fin1])

lemma rank_place_mono:
  "\place x < place y; x \ y\ \ rank x < rank y"
apply (rule linorder_cases, assumption)
apply (simp add: place_def cong: rank_lt_cong rank_eq_cong)
apply (drule choose_pos_lessD)
apply (rule finite_rank_eq)
apply (simp add: rank_eq_def)
apply (simp add: rank_eq_def)
apply simp
apply (drule place_rank_mono, simp)
done

lemma basis_emb_mono:
  "x \ y \ ubasis_le (basis_emb x) (basis_emb y)"
proof (induct "max (place x) (place y)" arbitrary: x y rule: less_induct)
  case less
  show ?case proof (rule linorder_cases)
    assume "place x < place y"
    then have "rank x < rank y"
      using \<open>x \<sqsubseteq> y\<close> by (rule rank_place_mono)
    with \<open>place x < place y\<close> show ?case
      apply (case_tac "y = compact_bot", simp)
      apply (simp add: basis_emb.simps [of y])
      apply (rule ubasis_le_trans [OF _ ubasis_le_lower [OF fin2]])
      apply (rule less)
       apply (simp add: less_max_iff_disj)
       apply (erule place_sub_less)
      apply (erule rank_less_imp_below_sub [OF \<open>x \<sqsubseteq> y\<close>])
      done
  next
    assume "place x = place y"
    hence "x = y" by (rule place_eqD)
    thus ?case by (simp add: ubasis_le_refl)
  next
    assume "place x > place y"
    with \<open>x \<sqsubseteq> y\<close> show ?case
      apply (case_tac "x = compact_bot", simp add: ubasis_le_minimal)
      apply (simp add: basis_emb.simps [of x])
      apply (rule ubasis_le_upper [OF fin2], simp)
      apply (rule less)
       apply (simp add: less_max_iff_disj)
       apply (erule place_sub_less)
      apply (erule rev_below_trans)
      apply (rule sub_below)
      done
  qed
qed

lemma inj_basis_emb: "inj basis_emb"
proof (rule injI)
  fix x y
  assume "basis_emb x = basis_emb y"
  then show "x = y"
    by (cases "x = compact_bot \ y = compact_bot") (auto simp add: basis_emb_rec fin2 place_eqD)
qed

definition
  basis_prj :: "ubasis \ 'a compact_basis"
where
  "basis_prj x = inv basis_emb
    (ubasis_until (\<lambda>x. x \<in> range (basis_emb :: 'a compact_basis \<Rightarrow> ubasis)) x)"

lemma basis_prj_basis_emb: "\x. basis_prj (basis_emb x) = x"
unfolding basis_prj_def
apply (subst ubasis_until_same)
  apply (rule rangeI)
apply (rule inv_f_f)
apply (rule inj_basis_emb)
done

lemma basis_prj_node:
  "\finite S; node i a S \ range (basis_emb :: 'a compact_basis \ nat)\
    \<Longrightarrow> basis_prj (node i a S) = (basis_prj a :: 'a compact_basis)"
unfolding basis_prj_def by simp

lemma basis_prj_0: "basis_prj 0 = compact_bot"
apply (subst basis_emb_compact_bot [symmetric])
apply (rule basis_prj_basis_emb)
done

lemma node_eq_basis_emb_iff:
  "finite S \ node i a S = basis_emb x \
    x \<noteq> compact_bot \<and> i = place x \<and> a = basis_emb (sub x) \<and>
        S = basis_emb ` {y. place y < place x \<and> x \<sqsubseteq> y}"
apply (cases "x = compact_bot", simp)
apply (simp add: basis_emb.simps [of x])
apply (simp add: fin2)
done

lemma basis_prj_mono: "ubasis_le a b \ basis_prj a \ basis_prj b"
proof (induct a b rule: ubasis_le.induct)
  case (ubasis_le_refl a) show ?case by (rule below_refl)
next
  case (ubasis_le_trans a b c) thus ?case by - (rule below_trans)
next
  case (ubasis_le_lower S a i) thus ?case
    apply (cases "node i a S \ range (basis_emb :: 'a compact_basis \ nat)")
     apply (erule rangeE, rename_tac x)
     apply (simp add: basis_prj_basis_emb)
     apply (simp add: node_eq_basis_emb_iff)
     apply (simp add: basis_prj_basis_emb)
     apply (rule sub_below)
    apply (simp add: basis_prj_node)
    done
next
  case (ubasis_le_upper S b a i) thus ?case
    apply (cases "node i a S \ range (basis_emb :: 'a compact_basis \ nat)")
     apply (erule rangeE, rename_tac x)
     apply (simp add: basis_prj_basis_emb)
     apply (clarsimp simp add: node_eq_basis_emb_iff)
     apply (simp add: basis_prj_basis_emb)
    apply (simp add: basis_prj_node)
    done
qed

lemma basis_emb_prj_less: "ubasis_le (basis_emb (basis_prj x)) x"
unfolding basis_prj_def
apply (subst f_inv_into_f [where f=basis_emb])
  apply (rule ubasis_until)
  apply (rule range_eqI [where x=compact_bot])
  apply simp
apply (rule ubasis_until_less)
done

lemma ideal_completion:
  "ideal_completion below Rep_compact_basis (approximants :: 'a \ _)"
proof
  fix w :: "'a"
  show "below.ideal (approximants w)"
  proof (rule below.idealI)
    have "Abs_compact_basis (approx 0\w) \ approximants w"
      by (simp add: approximants_def approx_below)
    thus "\x. x \ approximants w" ..
  next
    fix x y :: "'a compact_basis"
    assume x: "x \ approximants w" and y: "y \ approximants w"
    obtain i where i: "approx i\(Rep_compact_basis x) = Rep_compact_basis x"
      using compact_eq_approx Rep_compact_basis' by fast
    obtain j where j: "approx j\(Rep_compact_basis y) = Rep_compact_basis y"
      using compact_eq_approx Rep_compact_basis' by fast
    let ?z = "Abs_compact_basis (approx (max i j)\w)"
    have "?z \ approximants w"
      by (simp add: approximants_def approx_below)
    moreover from x y have "x \ ?z \ y \ ?z"
      by (simp add: approximants_def compact_le_def)
         (metis i j monofun_cfun chain_mono chain_approx max.cobounded1 max.cobounded2)
    ultimately show "\z \ approximants w. x \ z \ y \ z" ..
  next
    fix x y :: "'a compact_basis"
    assume "x \ y" "y \ approximants w" thus "x \ approximants w"
      unfolding approximants_def compact_le_def
      by (auto elim: below_trans)
  qed
next
  fix Y :: "nat \ 'a"
  assume "chain Y"
  thus "approximants (\i. Y i) = (\i. approximants (Y i))"
    unfolding approximants_def
    by (auto simp add: compact_below_lub_iff)
next
  fix a :: "'a compact_basis"
  show "approximants (Rep_compact_basis a) = {b. b \ a}"
    unfolding approximants_def compact_le_def ..
next
  fix x y :: "'a"
  assume "approximants x \ approximants y"
  hence "\z. compact z \ z \ x \ z \ y"
    by (simp add: approximants_def subset_eq)
       (metis Abs_compact_basis_inverse')
  hence "(\i. approx i\x) \ y"
    by (simp add: lub_below approx_below)
  thus "x \ y"
    by (simp add: lub_distribs)
next
  show "\f::'a compact_basis \ nat. inj f"
    by (rule exI, rule inj_place)
qed

end

interpretation compact_basis:
  ideal_completion below Rep_compact_basis
    "approximants :: 'a::bifinite \ 'a compact_basis set"
proof -
  obtain a :: "nat \ 'a \ 'a" where "approx_chain a"
    using bifinite ..
  hence "bifinite_approx_chain a"
    unfolding bifinite_approx_chain_def .
  thus "ideal_completion below Rep_compact_basis (approximants :: 'a \ _)"
    by (rule bifinite_approx_chain.ideal_completion)
qed

subsubsection \<open>EP-pair from any bifinite domain into \emph{udom}\<close>

context bifinite_approx_chain begin

definition
  udom_emb :: "'a \ udom"
where
  "udom_emb = compact_basis.extension (\x. udom_principal (basis_emb x))"

definition
  udom_prj :: "udom \ 'a"
where
  "udom_prj = udom.extension (\x. Rep_compact_basis (basis_prj x))"

lemma udom_emb_principal:
  "udom_emb\(Rep_compact_basis x) = udom_principal (basis_emb x)"
unfolding udom_emb_def
apply (rule compact_basis.extension_principal)
apply (rule udom.principal_mono)
apply (erule basis_emb_mono)
done

lemma udom_prj_principal:
  "udom_prj\(udom_principal x) = Rep_compact_basis (basis_prj x)"
unfolding udom_prj_def
apply (rule udom.extension_principal)
apply (rule compact_basis.principal_mono)
apply (erule basis_prj_mono)
done

lemma ep_pair_udom: "ep_pair udom_emb udom_prj"
apply standard
  apply (rule compact_basis.principal_induct, simp)
  apply (simp add: udom_emb_principal udom_prj_principal)
  apply (simp add: basis_prj_basis_emb)
apply (rule udom.principal_induct, simp)
apply (simp add: udom_emb_principal udom_prj_principal)
apply (rule basis_emb_prj_less)
done

end

abbreviation "udom_emb \ bifinite_approx_chain.udom_emb"
abbreviation "udom_prj \ bifinite_approx_chain.udom_prj"

lemmas ep_pair_udom =
  bifinite_approx_chain.ep_pair_udom [unfolded bifinite_approx_chain_def]

subsection \<open>Chain of approx functions for type \emph{udom}\<close>

definition
  udom_approx :: "nat \ udom \ udom"
where
  "udom_approx i =
    udom.extension (\<lambda>x. udom_principal (ubasis_until (\<lambda>y. y \<le> i) x))"

lemma udom_approx_mono:
  "ubasis_le a b \
    udom_principal (ubasis_until (\<lambda>y. y \<le> i) a) \<sqsubseteq>
    udom_principal (ubasis_until (\<lambda>y. y \<le> i) b)"
apply (rule udom.principal_mono)
apply (rule ubasis_until_mono)
apply (frule (2) order_less_le_trans [OF node_gt2])
apply (erule order_less_imp_le)
apply assumption
done

lemma adm_mem_finite: "\cont f; finite S\ \ adm (\x. f x \ S)"
by (erule adm_subst, induct set: finite, simp_all)

lemma udom_approx_principal:
  "udom_approx i\(udom_principal x) =
    udom_principal (ubasis_until (\<lambda>y. y \<le> i) x)"
unfolding udom_approx_def
apply (rule udom.extension_principal)
apply (erule udom_approx_mono)
done

lemma finite_deflation_udom_approx: "finite_deflation (udom_approx i)"
proof
  fix x show "udom_approx i\(udom_approx i\x) = udom_approx i\x"
    by (induct x rule: udom.principal_induct, simp)
       (simp add: udom_approx_principal ubasis_until_idem)
next
  fix x show "udom_approx i\x \ x"
    by (induct x rule: udom.principal_induct, simp)
       (simp add: udom_approx_principal ubasis_until_less)
next
  have *: "finite (range (\x. udom_principal (ubasis_until (\y. y \ i) x)))"
    apply (subst range_composition [where f=udom_principal])
    apply (simp add: finite_range_ubasis_until)
    done
  show "finite {x. udom_approx i\x = x}"
    apply (rule finite_range_imp_finite_fixes)
    apply (rule rev_finite_subset [OF *])
    apply (clarsimp, rename_tac x)
    apply (induct_tac x rule: udom.principal_induct)
    apply (simp add: adm_mem_finite *)
    apply (simp add: udom_approx_principal)
    done
qed

interpretation udom_approx: finite_deflation "udom_approx i"
by (rule finite_deflation_udom_approx)

lemma chain_udom_approx [simp]: "chain (\i. udom_approx i)"
unfolding udom_approx_def
apply (rule chainI)
apply (rule udom.extension_mono)
apply (erule udom_approx_mono)
apply (erule udom_approx_mono)
apply (rule udom.principal_mono)
apply (rule ubasis_until_chain, simp)
done

lemma lub_udom_approx [simp]: "(\i. udom_approx i) = ID"
apply (rule cfun_eqI, simp add: contlub_cfun_fun)
apply (rule below_antisym)
apply (rule lub_below)
apply (simp)
apply (rule udom_approx.below)
apply (rule_tac x=x in udom.principal_induct)
apply (simp add: lub_distribs)
apply (rule_tac i=a in below_lub)
apply simp
apply (simp add: udom_approx_principal)
apply (simp add: ubasis_until_same ubasis_le_refl)
done

lemma udom_approx [simp]: "approx_chain udom_approx"
proof
  show "chain (\i. udom_approx i)"
    by (rule chain_udom_approx)
  show "(\i. udom_approx i) = ID"
    by (rule lub_udom_approx)
qed

instance udom :: bifinite
  by standard (fast intro: udom_approx)

hide_const (open) node

unbundle binomial_syntax

end

quality99%

¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.8Angebot ¤

*Eine klare Vorstellung vom Zielzustand

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.