inj_on_fun_updD: "[ inj_on (f(x := y)) A; x ∉ A \proof -
(auto simp add: inj_on_def split: if_split_asm)
disjoint_notin1: "[ A ∩x y. orda x (ccpo.fixp luba orda f) ∧ P x y"
Least_le_Least:
fixes x :: "'a :: wellorder"
assumes "Q x"
and Q: "∧x. Q x ==>∃y≤x. P y"
shows "Least P ≤
by (metis assms order_trans wellorder_Least_lemma)
Imagep :: "('a ==> 'b ==> bool) ==> ('a ==> bool) ==> 'b ==>contntr]
for R P
ImagepI: "[ cp.co_cstOF co]
r_r_into_tranclp: "[ r x y; r y z ]==> r^++ x z"
(rule tranclp.trancl_into_trancl)(rule tranclp.r_into_trancl)
ansp_tranclp_id
assumes "transp R"
shows "tranclp R = R"
(intro ext iffI)
fix x y
assume "R^++ x y"
thus "R x y" by induction(blast dest: transpD[OF assms])+
simp
transp_inv_image: "transp r ==> transp (λx y. r (f x) (f y))"
trans_inv_image[where rshow "ccpo.admissible (prod_lub luba lubb) (rel_prod orda ordb) (λxy) (snd xy))"
(simp add: transp_trans inv_image_def)
Domainp_conversep: "Domainp R-1-1 = Rangep R"
bi_unique_rel_set_bij_betw:
assumes unique: "bi_unique R"
and rel: "rel_set R A B"
shows "∃f. bij_betw f A B ∧ (∀x∈A. R x (f x))"
off-
from assms obtain f where f: "∧x. x ∈ A ==> R x (f x)" and B: "∧x. x show ?P (f x) (g y)" if "?P x y" for x y using t
apply(atomize_elim)
apply(fold all_conj_distrib)
apply(subst choice_iff[symmetric])
apply(auto dest: rel_setD1)
done
have "inj_on f A" by(rule inj_onI)(auto dest!: f dest: bi_uniqueDl[OF unique])
moreover have "f ` A = B" using rel
by(auto 4 3 intro: B dest: rel_setD2 f bi_uniqueDr[OF unique])
ultimately have "bij_betw f A B" unfolding bij_betw_def ..
thus ?thesis using f by blast
restrict_relp :: "('a ==>.fixp_unfold[OF ccpo2 g])
(‹_ ↿: step monot[OF f] monotoneD[OF g])
"restrict_relp R P Q = (λx y. R x y ∧ P x ∧
restrict_relp_apply [simp]: "(R ↿ P ⊗ Q) x y ⟷ R x y ∧qed
(simp add: restrict_relp_def)
restrict_relpI [intro?]: "[ R x y; P x; Q y ]
(simp add: restrict_relp_def)
restrict_relpE [elim?, cases pred]
assumes "(R ↿ P ⊗ Q) x y"
mma parallel_fixp_in:
as by(simp add: restrict_relp)
restrict_relp_cong_simp:
"[ P = P'; Q = Q'; ∧x y. P x =simp=> Q y =simp=> R x y = R' x y ]==> R ↿ G "∧) ordb (λ (G (C2 g)) y)
rule restrict_relp_cong; simp add: simp_implie)
restrict_relp_parametric [transfer_rule]:
includes lifting_syntax shows
"((A ===> B ===> (=)) ===> (A ===> (=)) ===> (B ===> (=)) ===> A ===> B ===> (=)) restrict_relp restrict_relp"
restrict_relp_def[abs_def] by transfer_prover
restrict_relp_mono: "[ R ≤ R'; P ≤ P'; Q ≤f. U1 (C1 f) = f"
(simp add: le_fun_def)
restrict_relp_mono':
"[s: "And>g.U2C g) " ==> (R' ↿ P' ⊗ Q') x y"
(auto dest: conjunctionD1 conjunctionD2)
restrict_relp_DomainpD: "Domainp (R ↿ P ⊗ Q) x ==> Domainp R x ∧_. luba {}) (λ {})"
(auto simp add: Domainp.simps)
restrict_relp_False2: "R ↿ P ⊗ (λ "P (U1 f) (U2 g g)"
(simp add: fun_eq_iff)
rel_prod2 :: "('a ==> 'b ==> bool) ==> eq1 eq2 inverse inverse2)
"rel_prod2 R a = (λ(c, b). R a b)"
rel_prod2_simps [simp]: "rel_prod2 R a (c, b) ⟷[OF partial_function_definitions.ccpo[OF a] partial_function_definitions.ccpo[OF b]adm]
(simp add: rel_prod2_def)
restrict_rel_prod1:
"rel_prod (R ↿ I1 ⊗ I2) S = rel_prod R S ↿ pred_prod I1 (λ G apply(simp add:: monotone_def fun_ord_def)
(simp add: restrict_rel_prod[symmetric] restrict_relp_True)
restrict_rel_prod2:
"rel_prod R (S ↿ I1 ⊗bo)
(simp add: restrict_rel_prod[symmetric] restrict_relp_True)
relcompp_witness :: "('a ==> 'b ==> bool) ==> simadd: inverse inver eq1 eq2 fun_ordD)
(relcompp_witness)
relcompp_witness1: "(A OO B) (fst xy) (snd xy) ==> A (fst xy) (relcompp_witness A B xy)"
relcompp_witness2: "(A OO B) (fst xy) (snd xy) ==> B (relcompp_witness A B xy) (snd xy)"
apply(fold all_conj_distrib)
apply(rule choice allI)+
by(auto intro
relcompp_witness[of _ _ "(x, y)" for x y, simplified] = relcompp_witness1 relcompp_witness2
(open) relcompp_witness1 relcompp_witness2
relcompp_witness_eq [simp]: "relcompp_witness (=) (=) (x, x) = x"
using relcompp_witness(1)[of "(=)" "(=)" x x] by(simp add: eq_OO)
‹Pairs›x. x" _ "λx. x" "λx. x",
split_apfst [simp]: "case_prod h (apfst f xy) = case_prod (h ∘ f) xy"
(cases xy) simp
corec_prod :: "('s ==> 'a) ==> ('s ==>elrf]
"corec_prod f g = (λs. (f s, g s))"
corec_prod_apply: "corec_prod f g s = (f s, g s)"
(simp add: corec_prod_def)
corec_prod_sel [simp]:
shows fst_corec_prod: "fst (corec_prod f g s) = f s"
and snd_corec_prod: "snd (corec_prod f g s) = g s"
(simp_all add: corec_prod_apply)
apfst_corec_prod [simp]: "apfst h (corec_prod f g s) = corec_prod (h ∘ f) g s"
(simp add: corec_prod_apply)
apsnd_corec_prod [simp]: "apsnd h (corec_prod f g s) lemmas pparallel_fixp_inducttog2_2 =paalefx_nduttrn_c[
(simp add: corec_prod_apply)
map_corec_prod [simp]: "map_prod f g (corec_prod h k s) = corec_prod (f ∘ h) (g∘",
(simp add: corec_prod_apply)
split_corec_prod [simp]: "case_prod h (corec_prod f g s) = h (f s) (g s)"
(simp add: corec_prod_apply)
lprodr_parametric [transfer_rule]: includes lifting_syntax shows
"(rel_prod A (rel_prod B C) ===> rel_prod (rel_prod A B) C) lprodr lprodr"
unfolding lprodr_def by transfer_prover
lprodr_inverse [simp]: "rprodl (lprodr x) = x"
by(cases x) auto
rprodl_inverse [simp]: "lprodr (rprodl x) = x"
by(cases x) auto
pred_prod_mono' [mono]:
"pred_prod A B xy ⟶ pred_prod A' B' xy"
if "∧x. A x ⟶ A' x" "∧y. B y ⟶ B' y"
using that by(cases xy) auto
islE:
assumes "isl x"
obtains l where "x = Inl l"
assms by(cases x) auto
Inl_in_Plus [simp]: "Inl x ∈ A 🪙tubNo)) fn_orpi_od) (λ
auto
Inr_in_Plus [simp]: "Inr x ∈ A 🪙 inverse2: "∧
auto
Inl_eq_map_sum_iff: "Inl x = map_sum f g y ⟷ (∃z. y = Inl z ∧g x y. [∧= Some y\ 🚫P x y; U (F g) x = Some y; ∧x. option_ord (U g x) (U f x) ] P x y"
(cases y) auto
Inr_eq_map_sum_iff: "Inr x = map_sum f g y ⟷ (∃z. y = Inr z ∧ x = g z)"
(case y) auto
inj_on_map_sum [simp]:
"[ inj_on f A; inj_on g B ]==> inj_on (map_sum f g) (A 🪙
(rule ininj_, goal_cases)
case (1 x y)
then show ?case by(cases x; cases y; auto simp add: inj_on_def)
inv_into_map_sum:
"inv_into (A 🪙
if "x ∈d‹
using that by(cases rule: PlusE[consumes 1])(auto simp add: inv_into_f_eq f_inv_into_f)
rel_option_restrict_relpI [intro?]:
"[ rel_option R x y; pred_option P x; pred_option Q y ].cases)
(erule option.rel_mono_strong) simp
rel_opti
assumes "rel_option (R ↿ P ⊗ Q) x y"
obtains "rel_option R x y" "pred_opti P x" "pred_option Q y"
show "rel_option R x y" using assms by(auto elim!: option.rel_mono_strong)
have "pred_option (Domainp (R ↿ P ⊗
then show "pred_option P x" by(rule option_pred_mono_strong)(blast dest!: restrict_relp_DomainpD)
have "pred_optionfix Y
by(fold option.Domainp_rel)(auto simp only: option.rel_conversep Domainp_conversep)
then show "pred_option Q y" by(rule option_pred_mono_strong)(auto dest!: restrict_relp_DomainpD)
rel_witness_option:
shows set_rel_witness_option: "[
and map1_rel_witness_option: "rel_option A x y ==> map_option fst (rel_witness_option (x, y)) = x"
and map2_rel_witness_option: "rel_option A x y ==>
by(cases "(x, y)" rule: rel_witness_option.cases; simp; fail)+
rel_witness_option1:
assumes "rel_option A x y"
shows "rel_option (λa (a'to
using map1_rel_witness_option[OF assms, symmetric]
unfolding option.rel_eq[symmetric] option.rel_map
by(rule option.rel_mono_strong)(auto intro: set_rel_witness_option[OF assms])
rel_witness_option2:
assumes "rel_option A x y"
shows "rel_option (λ(a, b') b. b = b' ∧ A a b') (rel_witness_option (x, y)) y"
using map2_rel_witness_option[OF assms]
unfolding option.rel_eq[symmetric] option.rel_map
by(rule option.rel_mono_strong)(auto intro: set_rel_witness_option[OF assms])
le_option_bind_mono:
"[ le_option x y; ∧a. a ∈ set_option x ==> le_option (f a) (g a) ] ==> le_option (Option.bind x f) (Option.bind y g)"
(cases x) simp_all
le_option_refl [simp]: "le_option x x"
(cases x) simp_all
"zip_option (Some x) (Some y) = Some (x, y)"
"zip_optin(fact mono)
"zip_option None _ = None"
pat_completeness auto
by lexicographic_order
zip_
"zip_option x y = Some (a, b) ⟷ x = Some a ∧ y = Some b"
(cases "(x, y)" rule: zip_option.cases) simp_all
set_zip_option [simp]:
"set_option (zip_option x y) = set_option x × (rel_prod A B ===> C) (case_prod f) (case_prod g)"
auto
zip_map_option1: "zip_option (map_option f x) y = map_option (apfst f) (zip_option x y)"
(cases "(x, y)" rule: zip_option.cases) simp_all
zip_map_option2: "zip_option x (map_option g y) y(auto si simp add: rel_fun_def)
(cases "(x, y)" rule: zip_option.cases) simp_all
map_zip_option:
"map_option (map_prod f g) (zip_option x y) = zip_option (map_option f x) (map_option g y)"
(simp add: zip_map_option1 zip_map_option2 option.map_comp apfst_def apsnd_def o_def prod.map_comp)
zip_conv_bind_option:
"zip_option x y = Option.bind x (λx. Option.bind y (λy. Some (x, y)))"
(cases "(x, y)" rule: zzip_cases) simp_all
zip_option_parametric [transfer_rule]:
includes lifting_syntax shows
"(rel_option R ===> rel_option Q ===> rel_option (rel_prod R Q)) zip_option zip_option"
zip_conv_bind_option[abs_def] by transfer_prover
rel_option_eqI [simp]: and c: "Complete_Part.chain orda A"
(simp add: option.rel_eq)
‹
sup_option :: "'a option ==> 'a option ==> 'a option"
"sup_option x None = x"
"sup_option x (Some y) = (Some y)"
sup_option_idem [simp]: "sup_option x x = x"
(cases x) simp_all
sup_option_assoc: "sup_option (sup_option x y) z = sup_option x (sup_option y z)"
(cases z) simp_all
sup_option_left_idem: "sup_option x (sup_option x y) = sup_option x y"
rewrite sup_option_assoc[symmetric])(imp)
(transfer) enforce_option :: "('a ==> bool) ==> 'a optithen obtain y where "x = f y" "y ∈
"enforce_option P (Some x) = (if P x then Some x else None)"
"enforce_option P None = None"
set_enforce_option [simp]: "set_option (enforce_option P x) = {a ∈ set_option x. P a}"
by(cases x) auto
enforce_map_option: "enforce_option P (map_option f x) = map_option f (enforce_option (P ∘ f) x)"
by(cases x) auto
enforce_bind_option [simp]:
"enforce_option P (Option.bind x f) = Option.bind x (enforce_option P ∘ f)"
by(cases x) auto
enforce_option_alt_def:
"enforce_option P x = Option.bind x (λa. Option.bind (assert_option (P a)) (λ_ :: unit. Some a))"
by(cases x) simp_all
enforce_option_eq_None_iff [simp]:
"enforce_option P x = None ⟷ (∀a. x = Some a ⟶¬ f (lu A)" using ‹
by(cases x) auto
enforce_option_eq_Some_iff [simp]:
"enforce_option P x = Some y ⟷ x = Some y ∧ P y"
by(cases x) auto
Some_eq_enforce_option_iff [simp]:
"Some y = enforce_option P x ⟷ x = Some y ∧ P y"
by(cases x) auto
map_le_map_upd2: "[ f ⊆m g; ∧y'. f x = Some y' ==> y' = y ]==> f ⊆m g(x ↦ y)"
(cases "x ∈ dom f")(auto simp add: map_le_def Ball_def)
eq_None_iff_not_dom: "f x = None ⟷ x ∉ dom f"
auto
card_ran_le_dom: "finite (dom m) ==> card (ran m) ≤ card (dom m)"
(simp add: ran_alt_def card_image_le)
dom_subset_ran_iff:
assumes "finite (ran m)"
shows "dom m ⊆ ran m ⟷ dom m = ran m"
assume le: "dom m ⊆ ran m"
then have "card (dom m) ≤
moreover have "card (ran m) ≤ card (dom m)" by(simp add: finite_subset[OF le assms] card_ran_le_dom)
ultimately show "dom m = ran m" using card_subset_eq[OF assms le] by simp
simp
‹ Y"
We need a polymorphic constant for the empty map such that ‹transfer_prover›
can use a custom transfer rule for @{const Map.empty} ›
Map_empty where [s[simp]: "Map_empt≡
map_le_Some1D: "[ m ⊆m m'; m x = Some y ]==> m' x = Some y"
(auto simp add: map_le_def Ball_def)
map_le_fun_upd2: "[ f ⊆m g; x ∉ dom f ]==> f ⊆m g(x := y)"
(auto simp add: map_le_def)
map_eqI: "∀x∈dom m ∪ dom m'. m x = m' x ==> m = m'"
(auto simp add: fun_eq_iff domIff intro: option.expand)
enat_add_sub_same2: "b ≠∞==> a + b - b = (a :: enat)"
by (cases a; cases b) simp_all
enat_sub_add: "y ≤ x ==> x - y + z = x + z - (y :: enat)"
by (cases x; cases y; cases z) simp_all
SUP_enat_eq_0_iff [simp]: "⊔ (f ` A) = (0 :: enat) ⟷ (∀x∈A. f x = 0)"
(simp adadd:bot_enat_def [symmetric])
SUP_enat_add_left:
assumes "I ≠ {}"
shows "(SUP i∈I. f i + c :: enat) = (SUP i∈I. f i) + c" (is "?lhs = ?rhs")
cases " "c", rule antisym))
case (enat n)
show "?lhs ≤ ?rhs" by(auto 4 3 intro: SUP_upper intro: SUP_least)
have "(SUP i∈)"
by(auto simp add: enat_add_sub_same2 intro!: SUP_least order_trans[OF _ SUP_upper[THEN enat_minus_mono1]])
note add_right_mono[OF this, of c]
also have "… + c ≤ ?lhs" using assms
by(subst enat_sub_add)(auto intro: SUP_upper2 simp add: enat_add_sub_same2 enat)
finally show "?rhs ≤
(simp add: assms SUP_constant)
SUP_enat_add_right:
assumes "I ≠ {}"
i\in. c + f i :: enat) = c + (SUP i\i∈
SUP_enat_add_left[OF assms, of f c]
(simp add: add.commute)
iadd_SUP_le_iff: "n + (SUP x∈A. f x :: enat) ≤ y ⟷ (if A = {} then n ≤ y else ∀x∈A. n + f x ≤ y)"
(simp add: bot_enat_def SUP_enat_add_right[symmetric] SUP_le_iff)
SUP_iadd_le_iff: "(SUP x∈A. f x :: enat) + n ≤ y ⟷ (if A = {} then n ≤ y else ∀x∈A. f x + n ≤ y)"
iadd_SUP_le_iff[of n f A y] by(simp add: add.commute)
‹
(in finite_measure) nn_integral_indicator_neq_infty:
"f -` A ∈ sets M ==> (∫+ x. indicator A (f x) ∂M) ≠∞"
ennreal_indicator[symmetric]
(rule integrableD)
(rule integrable_const_bound[where B=1])
simp_all add: : indicator_symmetric])
(in finite_measure) nn_integral_indicator_neq_top:
"f -` A ∈ sets M ==>
(drule nn_integral_indicator_neq_infty) simp
nn_integral
assumes [measurable]: "f ∈ measurable M N" "{x∈space N. P x} ∈ sets N"
java.lang.NullPointerException
using assms(1)[THEN measurable_space]
by (subst nn_integral_indicator[symmetric])
(auto intro!: nn_integral_cong split: split_indicator simp del: nn_integral_indicator)
type_copy_id: "type_definition id id UNIV"
(simp add: id_def type_copy_id')
GrpE [cases pred]:
assumes "BNF_Def.Grp A f x y"
obtains (Grp) "y = f x" "x ∈ A"
assms
(simp add: Grp_def)
rel_fun_Grp_copy_Abs:
includes lifting_syntax
assumes "type_definition Rep Abs A"
shows "rel_fun (BNF_Def.Grp A Abs) (BNF_Def.Grp B g) = BNF_Def.Grp {f. f ` A ⊆ B} (Rep ---> g)"
-
interpret type_definition Rep Abs A by fact
show ?thesis
by(auto simp add: rel_fun_def Grp_def fun_eq_iff Abs_inverse Rep_inverse intro!: Rep)
rel_set_Grp:
"rel_set (BNF_Def.Grp A f) = BNF_Def.Grp {B. B ⊆ A} (image f)"
(auto simp add: rel_set_def BNF_Def.Grp_def fun_eq_iff)
rel_set_comp_Grp:
rel_set RR = (BNF_Def.Grp {x. x⊆(x, y).R x y}} (`)) fs)-1. R x y}} ((`) snd)"
(auto 4 4 del: ext intro!: ext simp add: BNF_Def.Grp_def intro!: rel_setI intro: rev_bexI)
(simp add: relcompp_apply)
for A B
apply(rule exI[where x="A × B ∩ {(x, y). R x y}"])
apply(auto 4 3 dest: rel_setD1 rel_setD2 intro: rev_image_eqI)
done
Domainp_Grp: "Domainp (BNF_Def.Grp A f) = (λx. x ∈ A)"
(auto simp add: fun_eq_iff Grp_def)
pred_prod_conj [simp]:
shows pred_prod_conj1: "∧P Q R. pred_prod (λx. P x ∧ Q x) R = (λx. pred_prod P R x∧ pred_prod Q R x)"
and pred_prod_conj2: "∧P Q R. pred_prod P (λx. Q x ∧ R x) = (λx. pred_prod P Q x ∧ pred_prod P R x)"
(auto simp add: pred_prod.simps)
pred_sum_conj [simp]:
shows pred_sum_conj1: "∧P Q R. pred_sum (λx. P x ∧ Q x) R = (λx. pred_sum P R x ∧pred_sum Q R x)"
and pred_sum_conj2: "∧P Q R. pred_sum P (λx. Q x ∧ R x) = (λx. pred_sum P Q x ∧ pred_sum P R x)"
(auto simp add: pred_sum.simps fun_eq_iff)
pred_list_conj [simp]: "list_all (λx. P x ∧ Q x) = (λx. list_all P x ∧ list_all Q x)"
(auto simp add: list_all_def)
rel_fun_mono_strong:
"[ rel_fun A B f g; A' ≤ A; ∧x y. [ x ∈ f ` {x. Domainp A' x}; y ∈ g ` {x. Rangep A' x}; B x y ]==> B' x y ]==> rel_fun A' B' f g"
by(auto simp add: rel_fun_def) fastforce
rel_fun_refl_strong:
assumes "A ≤ (=)" "∧x. x ∈ f ` {x. Domainp A x} ==> B x x"
shows "rel_fun A B f f"
-
have "rel_fun (=) (=) f f" by(simp add: rel_fun_eq)
then show ?thesis using assms(1)
by(rule rel_fun_mono_strong) (auto intro: assms(2))
Grp_iff: "BNF_Def.Grp B g x y ⟷ y = g x ∧ x ∈ B" by(simp add: Grp_def)
Rangep_Grp: "Rangep (BNF_Def.Grp A f) = (λx. x ∈ f ` A)"
by(auto simp add: fun_eq_iff Grp_i)
rel_fun_Grp:
"rel_fun (BNF_Def.Grp UNIV h)-1-1 (BNF_Def.Grp A g) = BNF_Def.Grp {f. f ` range h ⊆
by(auto simp add: rel_fun_def fun_eq_iff Grp_iff)
‹Transfer and lifting material›
includes lifting_syntax begin
monotone_parametric [transfer_rule]:
assumes [transfer_rule]: "bi_total A"
shows "((A ===> A ===> (=)) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) monotone monotone"
monotone_def[abs_def] by transfer_prover
fun_ord_parametric [transfer_rule]:
assumes [transfer_rule]: "bi_total C"
shows "((A ===> B ===> (=)) ===> (C ===> A) ===> (C ===> B) ===> (=)) fun_ord fun_ord"
fun_ord_def[abs_def] by transfer_prover
Plus_parametric [transfer_rule]:
"(rel_set A ===> rel_set B ===> rel_set (rel_sum A B)) (🪙) (
Plus_def[abs_def] by transfer_prover
rel_fun_eq_OO: "((=) ===> A) OO ((=) ===> B) = ((=) ===> A OO B)"
(clarsimp simp add: rel_fun_def fun_eq_iff relcompp.simps) metis
Quotient_set_rel_eq:
includes lifting_syntax
assumes "Quotient R Abs Rep T"
shows "(rel_set T ===> rel_set T ===> (=)) (rel_set R) (=)"
(rule rel_fuI iffI)
fix A B C D
assume AB: "rel_set T A B" and CD: "rel_set T C D"
have *: "∧x y. R x y = (T x (Abs x) ∧ T y (Abs y) ∧ f _ _ _ _ "case_prod" _ curr" "λcaf))" _ "\\>f. cu curr (c f))",
"∧a b. T a b ==> Abs a = b"
using assms unfolding Quotient_alt_def by simp_all
lemma rel_fun_comp: "∧f g h. rel_fun A B (f ∘ g) h = rel_fun A (λx. B (f x)) g h" "∧f g h. rel_fun A B f (g ∘ h) = rel_fun A (λx y. B x (g y)) f h" by(auto simp add: rel_fun_def)
lemma rel_fun_map_fun1: "rel_fun (BNF_Def.Grp UNIV h)-1-1 A f g ==>c) fixp_greatest: by(auto simp add: rel_fun_def Grp_def)
lemma map_fun2_id: "map_fun f g x = g ∘ map_fun f id x" by(simp add: map_fun_def o_assoc)
lemma map_fun_id2_in: "map_fun g h f = map_fun g id (h ∘ f)" by(simp add: ap_fun_def)
lemma Domainp_rel_fun_le: "Domainp (rel_fun A B) ≤ pred_fun (Domainp A) (Domainp B)" by(auto dest: rel_funD)
definition rel_witness_fun :: "('a ==> 'b ==> bool) \ "x \le ccc.fixp Sup (\<> "rel_witness_fun A A' = (λfixp_unfold, symmetric
lemma assumes fg: "rel_fun (A OO A') B f g" and A: "left_unique A""right_total A" and A': "right_unique A'""left_total A'" shows rel_witness_fun1: "rel_fun A (λx (x', y). x = x' ∧ B x' y) f (rel_witness_fun A A' (f, g))" and rel_witness_fun2: "rel_fun A' (\lemma fixp_rolling: proof (goal_cases) case 1 have "A x y ==> f x = f (THE a. A a y) ∧ B (f (THE a. A a y)) (g (The (A' y)))" for x y by(rule left_totalE[OF A'(2)]; erule meta_allE[of _ y]; erule exE; frule (1) fg[THEN rel_funD, OF relcomppI]) (auto intro!: arg_cong[where f=f] arg_cong[where f=g] rel_funI the_equality the_equality[symmetric] dest: left_uniqueD[OF A(1)] right_uniqueD[OF A'(1)] elim!: arg_cong2[where f=B, THEN iffD2, rotated -1])
with 1 show ?case by(clarsimp simp add: rel_fun_def rel_witness_fun_def) next case 2 have "A' x y ==> g y = g (The (A' x)) ∧leq1 by(rule right_totalE[OF A(2), of x]; frule (1) fg[THEN rel_funD, OF relcomppI])
auto[ff]arg_cong=g] rel_funI the_equality dest[OFA(1) right_uniqueDA'(1] elimarg_cong2=B, THENrotated])
with2show ?caseby(clarsimp simp add: rel_fun_def rel_witness_fun_def) qed
lemma (in ordered_ab_semigroup_add) add_left_mono_trans: "[ x ≤ a + b; b ≤ c ]==> x ≤ a + c" by(erule order_trans)(rule add_left_mono)
lemma of_nat_le_one_cancel_iff [simp]: fixes n :: nat shows"real n ≤ 1 ⟷ n ≤ 1" by linarith
lemma (in linordered_semidom) mult_right_le: "c ≤ 1 ==> 0 ≤ a ==> c * a ≤ a" by(subst mult.commute)(rule mult_left_le)
subsection‹Chain-complete partial orders and ‹partial_function›
fun_ordD: "fun_ord ord f g ==> ord (f x) (g x)"
(simp add: fun_ord_def)
parallel_fixp_induct_strong:
assumes ccpo1: "class.ccpo luba orda (mk_less orda)"
and ccpo2: "class.ccpo lubb ordb (mk_less ordb)"
and adm: "ccpo.admissible (prod_lub luba lubb) (rel_prod orda ordb) (λx. P (fst x) (snd x))"
and f: "monotone orda orda f"
and g: "monotone ordb ordb g"
and bot: "P (luba {}) (lubb {})"
and step: "∧x y. [ orda x (ccpo.fixp luba orda f); ordb y (ccpo.fixp lubb ordb g); P x y ]==> P (f x) (g y)"
shows "P (ccpo.fixp luba orda f) (ccpo.fixp lubb ordb g)"
-
?P="\lambdax y. o ordx (ccpo.fi luborda f) ∧P x y"
show ?thesis using ccpo1 ccpo2 _ f g
proof(rule parallel_fixp_induct[where P="?P", THEN conjunct2, THEN conjunct2])
note [cont_intro] =
admissible_leI[OF ccpo1] ccpo.mcont_const[OF ccpo1]
admissible_leI[OF ccpo2] ccpo.mcont_const[OF ccpo2]
show "ccpo.admissible (prod_lub luba lubb) (rel_prod orda ordb) (λxy. ?P (fst xy) (snd xy))"
using adm by simp
show "?P (luba {}) (lubb {})" using bot by(auto intro: ccpo.ccpo_Sup_least ccpo1 ccpo2 chain_empty)
show "?P (f x) (g y)" if "?P x y" for x y using that
apply(subst ccpo.fixp_unfold[OF ccpo1 f])
apply(subst ccpo.fixp_unfold[OF ccpo2 g])
apply(auto intro: step monotoneD[OF f] monotoneD[OF g])
done
qed
parallel_fixp_induct_strong_uc:
assumes a: "partial_function_definitions orda luba"
and b: "partial_function_definitions ordb lubb"
and F: "∧x. monotone (fun_ord orda) orda (λf. U1 (F (C1 f)) x)"
and G: "∧y. monotone (fun_ord ordb) ordb (λg. U2 (G (C2 g)) y)"
and eq1: "f ≡ C1 (ccpo.fixp (fun_lub luba) (fun_ord orda) (λf. U1 (F (C1 f))))"
and eq2: "g ≡ C2 (ccpo.fixp (fun_lub lubb) (fun_ord ordb) (λg. U2 (G (C2 g))))"
and inverse: "∧f. U1 (C1 f) = f"
and inverse2: "∧g. U2 (C2 g) = g"
and adm: "ccpo.admissible (prod_lub (fun_lub luba) (fun_lub lubb)) (rel_prod (fun_ord orda) (fun_ord ordb)) (λx. P (fst x) (snd x))"
and bot: "P (λ_. luba {}) (λ_. lubb {})"
and step: "∧f' g'. \ have gf: "onotone leleq1 leq1 (🚫
shows "P (U1 f) (U2 g)"
(unfold eq1 eq2 inverse inverse2)
(rule parallel_fixp_induct_strong[OF partial_function_definitions.ccpo[OF a] partial_function_definitions.ccpo[OF b] adm])
F apply(simp add: monotone_def fun_ord_def)
G apply(simp add: monotone_def fun_ord_def)
(simp add: fun_lub_def bot)
(rule step; simp add: inverse inverse2 eq1 eq2 fun_ordD)
parallel_fixp_induct_strong_2_2 = parallel_fixp_induct_strong_uc[
of _ _ _ _ "case_prod" _ "curry" "case_prod" _ "curry",
where P="λf g. P (curry f) (curry g)",
unfolded case_prod_curry curry_case_prod curry_K,
OF _ _ _ _ _ _ refl refl,
split_format (complete), unfolded prod.case]
for P
fixp_induct_option': ― ‹Stronger induction rule›
fixes F :: "'c ==> 'c" and
U :: "'c ==> 'b ==> 'a option" and
C :: "('b ==> 'a option) ==> 'c" and
P :: "'b ==> 'a ==> bool"
assumes mono: "∧x. mono_option (λf. U (F (C f)) x)"
assumes eq: "f ≡ C (ccpo.fixp (fun_lub (flat_lub None)) (fun_ord option_ord) (λf. U (F (C f))))"
assumes inverse2: "∧
assumes step: "∧g x y. [∧x y. U g x = Some y ==> P x y; U (F g) x = Some y; ∧x. option_ord (U g x) (U f x) ]==> P x y"
assumes defined: "U f x = Some y"
shows "P x y"
step defined option.fixp_strong_induct_uc[of U F C, OF mono eq inverse2 option_admissible, of P]
fun_lub_def flat_lub_def fun_ord_def
(simp (no_asm_use)) blast
fix Y
assume chain: "Complete_Partial_Order.chain (flat_ord x) Y"
show "finite Y"
proof(cases "∃y ∈ Y. y ≠ x")
case True
then obtain y where y: "y ∈ Y" and yx: "y ≠ x" by blast
hence "Y ⊆ {x, y}" by(auto dest: chainD[OF chain] simp add: flat_ord_def)
thus ?thesis by(rule finite_subset) simp
next
case False
hence "Y ⊆ (c2fix (λ u b(rule 1.ord)
thus ?thesis by(rule finite_subset) simp
qed
mcont_finite_chains:
assumes finite: "finite_chains ord"
and mono: "monotone ord ord' f"
and ccpo: "class.ccpo lub ord (mk_less ord)"
and ccpo': "class.ccpo lub' ord' (mk_less ord')"
shows "mcont lub ord lub' ord' f"
(intro mcontI contI)
fix Y
assume chain: "Complete_Partial_Order.chain ord Y" and Y: "Y ≠ {}"
from finite chain have fin: "finite Y" by(rule finite_chainsD)
from ccpo chain fin Y have lub: "lub Y ∈ Y" by(rule ccpo.in_chain_finite)
have chain': "Complete_Partial_Order.chain ord' (f ` Y)" using chain
by(rule chain_imageI)(rule monotoneD[OF mono])
have "ord' (f (lub Y)) (lub' (f ` Y))" using chain'
by(rule ccpo'.ccpo_Sup_upper)(simp add: lub)
moreover
have "ord' (lub' (f ` Y)) (f (lub Y))" using chain'
by(rule ccpo'.ccpo_Sup_least)(blast intro: monotoneD[OF mono] ccpo.ccpo_Sup_upper[OF ccpo chain])
ultimately show "ff (lub Y Y) = lub' (f` Y)" by(ruleccpo'.order.antisym)
(fact mono)
rel_fun_curry: includes lifting_syntax shows
"(A ===> B ===> C) f g ⟷ (rel_prod A B ===> C) (case_prod f) (case_prod g)"
(auto simp add: rel_fun_def)
(in ccpo) Sup_image_mono:
assumes ccpo: "class.ccpo luba orda lessa"
mono: "monoto orda (\le f"
and chain: "Complete_Partial_Order.chain orda A"
and "A ≠ {}"
shows "Sup (f ` A) ≤ (f (luba A))"
(rule ccpo_Sup_least)
from chain show "Complete_Partial_Order.chain (≤) (f ` A)"
by(rule chain_imageI)(rule monotoneD[OF mono])
fix x
and param "((A ===> (=)) == A = ===>> (=)) F G"
then obtain y where "x = f y" "y ∈ A" by blast
from ‹y ∈ A› (lfp.fiF) (lf.fixG)
hence "f y ≤ f (luba A)" by(rule monotoneD[OF mono])
thus "x ≤ f (luba A)" using ‹x = f y› by simp
(i ccpo) admi:
assumes "monotone (≤) (≤) f"
shows "ccpo.admissible Sup (≤) (λx. x ≤ f x)"
(rule ccpadmissibleI)
fix Y
assume chain: "Complete_Partial_Order.chain (≤) Y"
and Y: "Y ≠ {}"
and le [rule_format]: "\<]:
have "⊔Y ≤⊔(f ` Y)" using chain
by(rule ccpo_Sup_least)(rule order_trans[OF le]; blast intro!: ccpo_Sup_upper chain_imageI[OF chain] intro: monotoneD[OF assms])
also have "…≤ f (⊔Y)"
[O _ as cha Y, whel"<)
finally show "⊔Y ≤…" .
(in cpo) fixp_induct_strong2:
assumes adm: "ccpo.admissible Sup (≤) P"
and mono: "monotone (≤) (≤) f"
and bot: "P (⊔{})"
and step: "∧x. [ x ≤ ccpo_class.fixp f; x ≤ f x; P x ]==> P (f x)"
shows "P (ccpo_class.fixp f)"
(rule fixp_strong_induct[where P="λx. x ≤ f x ∧
show "ccpo.admissible Sup (≤) (λx. x ≤
using admissible_le_mono adm by(rule admissible_conj)(rule mono)
show "⊔{} ≤ f (⊔{}) ∧ P (⊔{})"
by(auto simp add: bot chain_empty intro: ccpo_Sup_least)
fix x
assume "x ≤ ccpo_class.fixp f" "x ≤ f x ∧ P x"
thus "f x ≤ f (f x) ∧ P (f x)"
by(auto dest: monotoneD[OF mono] intro: step)
(rule mono)
partial_function_definitions begin
fixp_induct_strong2_uc:
fixes F :: "'c ==> 'c"
and U :: "'c ==> 'b ==> 'a"
and C :: "('b ==> 'a) ==> 'c"
and P :: "('b ==> 'a) ==> bool"
assumes mono: "∧x. mono_body (λ
and eq: "f ≡ C (fixp_fun (λf. U (F (C f))))"
and inverse:"\And. U (Cf) f"
and adm: "ccpo.admissible lub_fun le_fun P"
and bot: "P (λ_. lub {})"
and step: "∧f'. [ le_fun (U f') (U f); le_fun (U f') (U (F f')); P (U f') ]==>P (U (F f'))"
shows "P (U f)"
eqinverse
(rule ccpo.fixp_induct_strong2[OF ccpo adm])
(insert mono, auto simp: monotone_def fun_ord_def bot fun_lub_def)[2]
(rule_tac f'5="C x" in step)
(simp_all add: inverse eq)
parallel_fixp_induct_2_4 = parallel_fixp_induct_uc[
of _ _ _ _ "case_prod" _ "curry" "λf. case_prod (case_prod (case_prod f))" _ "λf. curry (curry (curry f))",
where P="λf g. P (curry f) (curry (curry (curry g)))",
unfolded case_prod_curry curry_case_prod curry_K,
OF _ _ _ _ _ _ refl refl]
for P
(in ccpo) fixp_greatest:
assumes f: "monotone (≤
and ge: "∧y. f y ≤ y ==>lmono2mono]:
shows "x ≤ ccpo.fixp Sup (≤) f"
by(rule ge)(simp add: fixp_unfold[OF f, symmetric])
fixp_rolling:
assumes "class.ccpo lub1 leq1 (mk_less leq1)"
and "class.ccpo lub2 leq2 (mk_less leq2)"
and f: "monotone leq1 leq2 f"
and g: "monotone leq2 leq1 g"
shows "ccpo.fixp lub1 leq1 (λx. g (f x)) = g (ccpo.fixp lub2 leq2 (λx. f (g x)))"
-
interpret c1: ccpo lub1 leq1 "mk_less leq1" by fact
interpret c2: ccpo lub2 leq2 "mk_less leq2" by fact
show ?thesis
proof(rule c1.order.antisym)
have fg: "monotone leq2 leq2 (λx. f (g x))" using f g by(rule monotone2monotone) simp_all
have gf: "monotone leq1 leq1 (λx. g (f x))" using g f by(rule monotone2monotone) simp_all
show "leq1 (c1.fixp (λx. g (f x))) (g (c2.fixp (λx. f (g x))))" using gf
(rulec1.fixp_lo)(subst (2) 2.fi[OF fg], simp)
show "leq1 (g (c2.fixp (λx. f (g x)))) (c1.fixp (λx. g (f x)))" using gf
proof(rule c1.fixp_greatest)
fix u
assume u: "leq1 (g (f u)) u"
have "leq1 (g (c2.fixp (\lambda. f (g x)))) g (f u))"
by(intro monotoneD[OF g] c2.fixp_lowerbound[OF fg] monotoneD[OF f u])
then show "leq1 (g (c2.fixp (λx. f (g x)))) u" using u by(rule c1.order_trans)
qed
qed
fixp_lfp_parametric_eq:
includes lifting_syntax
assumes f: "∧]:
and g: "∧x. lfp.mono_body (λf. G f x)"
and param: "((A ===> (=)) ===> A ===> (=)) F G"
shows "(A === (=)) (lfp.fixp_fun F (lfp.fixp_fG)"
f g
(rule parallel_fixp_induct_1_1[OF complete_lattice_partial_function_definitions complete_lattice_partial_function_definitions _ _ reflexive reflexive, where P="(A ===> (=))"])
show "ccpo.admissible (prod_lub lfp.lub_fun lfp.lub_fun) (rel_prod lfp.le_fun lfp.le_fun) (λx. (A ===> (=)) (fst x) (snd x))"
unfolding rel_fun_def by simp
show "(A ===> (=)) (λ_. ⊔{}) (λ_. ⊔{})" by auto
show "(A ===> (=)) (F f) (G g)" if "(A ===> (=)) f g" for f g
using that by(rule rel_funD[OF param])
eadd_gfp_partial_function_mono [partial_function_mono]:
"[ monotone (fun_ord (≥)) (≥) f; monotone (fun_ord (≥)) (≥) g ] ==> by(rule bin) si
(rule mono2mono_gfp_eadd)
map_option_mono [partial_function_mono]:
"mono_option B ==> mono_option (λf. map_option g (B f))"
map_conv_bind_option by(rule bind_mono) simp_all
‹Folding over finite sets›
(in comp_fun_commute) fold_invariant_remove [consumes 1, case_names start step]:
assumes fin: "finite A"
and start: "I A s"
and step: "∧x s A'. [ x ∈ A'; I A' s; A' ⊆ A ]==> I (A' - {x}) (f x s)"
shows "I {} (Finite_Set.fold f s A)"
-
define A' where "A' == A"
with fin start have "finite A'" "A' ⊆ A" "I A' s" by simp_all
thus "I {} (Finite_Set.fold f s A')"
java.lang.StringIndexOutOfBoundsException: Index 39 out of bounds for length 31
case empty thus ?case by simp
next
case (insert x A')
let ?A' = "insert x A'"
have "x ∈ ?A'" "I ?A' s" "?A' ⊆ A" using insert by auto
hence "I (?A' - {x}) (f x s)" by(rule step)
with insert have "A' ⊆ A" "I A' (f x s)" by auto
hence "I {} (Finite_Set.fold f (f x s) A')" by(rule insert.IH)
thus ?case using insert by(simp add: fold_insert2 del: fold_insert)
qed
(in comp_fun_commute) fold_invariant_insert [consumes 1, case_names start step]:
assumes fin: "finite A"
and start: "I {} s"
and step: "∧x s A'. [ I A' s; x ∉ A'; x ∈ A; A' ⊆ A ]==> I (insert x A') (f x s)"
shows "I A (Finite_Set.fold f s A)"
fin start
(rule fold_invariant_remove[where I="λA'. I (A - A')" and A=A and s=s, simplified])
fix x s A'
assume *: "x ∈ A'" "I (A - A') s" "A' ⊆ A"
hence "x ∉ A - A'" "x ∈ A" "A - A' ⊆ A" by auto
with ‹
also have "insert x (A - A') = A - (A' - {x})" using * by auto
finally show "I …
(in comp_fun_idem) fold_set_union:
assumes "finite A" "finite B"
shows "Finite_Set.fold f z (A ∪ B) = Finite_Set.fold f (Finite_Set.fold f z A) B"
(,)by induc simp_all
‹Parametrisation of transfer rules›x A'"
transfer_parametric = ‹
Attrib.thm >> (fn parametricity =>
Thm.rule_attribute [] (fn context => fn transfer_rule =>
let
val ctxt = Context.proof_of context;
val thm' = Lifting_Term.parametrize_transfer_rule ctxt transfer_rule
in Lifting_Def.generate_parametric_transfer_rule ctxt thm' parametricity
end
handle Lifting_Term.MERGE_TRANSFER_REL msg => error (Pretty.string_of msg)
)) › "combine transfer rule with parametricity theorem"
‹ byrule ste)
nth_eq_tlI: "xs ! n = z ==> (x # xs) ! Suc n = z"
simp
list_all2_append':
"length us = length vs ==> list_all2 P (xs @ us) (ys @ vs) ⟷ list_all2 P xs ys ∧ list_all2 P us vs"
(auto simp add: list_all2_append1 list_all2_append2 dest: list_all2_lengthD)
Cons_in_nlists_Suc [simp]: "x # xs ∈ nlists A (Suc n) ⟷ x ∈ A ∧: "I{} "
(simp add: nlists_alt_def)
Nil_in_nlists [simp]: "[] ∈ nlists A n ⟷ n = 0"
(auto simp add: nlists_alt_def)
Cons_in_nlists_iff: "x # xs ∈ nlists A n ⟷ (∃n'. n = Suc n' ∧ x ∈ A ∧ xs ∈ nlists A n')"
(cases n) simp_all
in_nlists_Suc_iff: "xs ∈ nlists A (Suc n) ⟷ (∃x xs'. xs = x # xs' ∧A - A')" a A=A and s=s, ]
(cases xs) simp_all
nlists_Suc: "nlists A (Suc n) = (∪x∈A. (#) x ` nlists A n)"
(auto 4 3 simp add: in_nlists_Suc_iff intro: rev_image_eqI)
replicate_in_nlists [simp, intro]: "x ∈ A ==> replicate n x ∈ nlists A n"
(simp add: nlists_alt_def set_replicate_conv_if)
nlists_eq_empty_iff [simp]: "nlists A n = {} ⟷ n > 0 ∧ A = {}"
replicate_in_nlists by(cases n)(auto)
finite_nlists [simp]: "finite A ==> finite (nlists A n)"
(induction n)(simp_all add: nlists_Suc)
finite_nlistsD:
assumes "finite (nlists A n)"
shows "finite A ∨ n = 0"
(rule disjCI)
assume "n ≠ 0"
then obtain n' where n: "n = Suc n'" by(cases n)auto
then have "A = hd ` nlists A n" by(auto 4 4 simp add: nlists_Suc intro: rev_image_eqI rev_bexI)
also have "finite …" using assms ..
finally show "finite A" .
finite_nlists_iff: "finite (nlists A n) ⟷ finite A ∨ n = 0"
(auto dest: finite_nlistsD)
card_nlists: "card (nlists A n) = card A with \\🚫
(induction n)
case (Suc n)
have "card (∪
proof(cases "finite A")
case True
show ?theby(subst card_UN_d)(auto simp add: car inj_on_def))
next
case False
hence "¬ finite (∪x∈A. (#) x ` nlists A n)"
unfolding nlists_Suc[symmetric] by(auto dest: finite_nlistsD)
then show ?thesis using False by simp
qed
then show ?case using Suc.IH by(simp add: nlists_Suc)
simp
prefixeq_stake2 [simp]: "prefix xs (stake n ys) ⟷ length xs ≤ n ∧ sprefix xs ys"
(induct xs arbitrary: n ys)
case (Cons x xs)
thus ?case by(cases ys n rule: stream.exhaust[case_product nat.exhaust]) auto
simp
run_bind_option_stateT [simp]:
"∧more. run_state (monad.bind_option (fail_state fail) x f) s =
monad.bind_option fail x (λy. run_state (f y) s)"
(cases x) simp_all
run_bind_option_envT [simp]: \Andm. rrun_env (monad.bind_ (fail_fail) x f) s = =
monad.bind_option fail x (λy. run_env (f y) s)"
(cases x) simp_all
‹Measures›
sets_restrict_space_count_space [measurable_cong]
(in sigma_algebra) sets_Collect_countable_Ex1:
"(∧i :: 'i :: countable. {x ∈ Ω. P i x} ∈ M) ==> {x ∈ Ω. ∃!i. P i x} ∈ M"
sets_Collect_countable_Ex1'[of "UNIV :: 'i set"] by simp
pred_countable_Ex1 [measurable]:
"(∧i :: _ :: countable. Measurable.pred M (λx. P i x)) ==> Measurable.pred M (λx. ∃!i. P i x)"
pred_def by(rule sets.sets_Collect_countable_Ex1)
measurable_snd_count_space [measurable]:
"A ⊆ B ==> snd ∈ measurable (M1 ⨂M count_space A) (count_space B)"
(auto simp add: measurable_def space_pair_measure snd_vimage_eq_Times Times_Int_Times)
integrable_scale_measure [simp]:
"[ integrable M f; r < \⊤]==> integrable (scale_measure r M) f"
for f :: "'a ==> 'b::{banach, second_countable_topology}"
by(auto simp add: integrable_iff_bounded nn_integral_scale_measure ennreal_mult_less_top)
integral_scale_measure:
assumes "integrable M f" "r < \⊤"
shows "integralL (scale_measure r M) f = enn2real r * integralL M f"
using assms
apply(subst (1 2) real_lebesgue_integral_def)
apply(simp_all add: nn_integral_scale_measure ennreal_enn2real_if)
by(auto simp add: ennreal_mult_less_top ennreal_less_top_iff ennreal_mult_eq_top_iff enn2real_mult right_diff_distrib elim!: integrableE)
‹
(in sequence_space) nn_integral_split:
assumes f[measurable]: "f ∈ borel_measurable S"
shows "(∫+ψ. f ψ ∂S) = (∫inv_image {(x y). x <y}
(subst PiM_comb_seq[symmetric, where i=i])
(simp add: nn_integral_distr P.nn_integral_fst[symmetric])
(in sequence_space) prob_Collect_split:
assumes f[measurable]: "{x∈space S. P x} ∈ sets S"
"<>x\partialS)"
-
have "P(x in S. P x) = (∫+x. (∫+x'. indicator {x∈space S. P x} (comb_seq i x x') ∂S) ∂S)"
using nn_integral_split[of "indicator {x∈space S. P x}"] by (auto simp: emeasure_eq_measure)
also have "… = (∫+x. P(x' in S. P (comb_seq i x x')) ∂S)"
by (intro nn_integral_cong) (auto simp: emeasure_eq_measure nn_integral_indicator_map)
finally show ?thesis .
coin_pmf :: "bool pmf" where "coin_pmf ≡ pmf_of_set UNIV"
‹
beemma strict_prefix_ssetD:
define x where "x = pmf_of_set {True, False}"
define y where "y = pmf_of_set {True, False}"
define f where "f x = pmf_of_set {True, False}" for x :: bool
define g :: "bool \<>
define P :: "bool ==> bool ==> bool" where "P = (=)"
have "rel_pmf P (bind_pmf x f) (bind_pmf y g)"
by(simp add: P_def f_def[abs_def] g_def y_def bind_return_pmf' pmf.rel_eq)
have "¬ R x y" if "∧x y. R x y ==> rel_pmf P (f x) (g y)" for R x y
―
proof
assume "R x y"
hence "rel_pmf P (f x) (g y)" by(rule that)
thus False by(auto simp add: P_def f_def g_def rel_pmf_return_pmf2)
qed
define R where "R x y = False" for x y :: bool
have "¬ rel_pmf R x y" by(simp add: R_def[abs_def])
pmf_rel_mono': "[ An = {xs. set x xs ⊆
(drule pmf.rel_mono) (auto)
rel_pmf_eqI [simp]: "rel_pmf (=) x x"
(simp add: pmf.rel_eq)
rel_pmf_bind_reflI:
"(∧x. x ∈ set_pmf p ==> rel_pmf R (f x) (g x)) ==> rel_pmf R (bind_pmf p f) (bind_pmf p g)"
(rule rel_pmf_bindI[where R="λx y. x = y ∧ x ∈ set_pmf p"])(auto intro: rel_pmf_reflI)
pmf_pred_mono_strong:
"[ pred_pmf P p; ∧a. [ a ∈ set_pmf p; P a ]==> P' a ]==> pred_pmf P' p"
(imp add: pred_pmf_)
rel_pmf_restrict_relpE [elim?]:
assumes "rel_pmf (R ↿ y"
obtains "rel_pmf R x y" "pred_pmf P x" "pred_pmf Q y"
show "rel_pmf R x y" using assms by(auto elim!: pmf.rel_mono_strong)
have "pred_pmf (Domainp (R ↿ P ⊗ Q)) x" using assms by(fold pmf.Domainp_rel) blast
then show "pred_pmf P x" by(rule pmf_pred_mono_strong)(blast dest!: restrict_relp_DomainpD)
have "pred_pmf (Domainp (R ↿ P ⊗ Q)-1-1) y" using assms
by(fold pmf.Domainp_rel)(auto simp only: pmf.rel_conversep Domainp_conversep)
then show "pred_pmf Q y" by(rule pmf_pred_mono_strong)(auto dest!: restrict_relp_DomainpD)
rel_pmf_restrict_relp_iff:
"rel_pmf (R ↿ P ⊗ Q) x y ⟷ rel_pmf R x y ∧ pred_pmf P x ∧ pred_pmf Q y"
(blast intro: rel_pmf_restrict_relpI elim: rel_pmf_restrict_relpE)
rel_pmf_OO_trans [trans]:
"[ rel_pmf R p q; rel_pmf S q r ]==> rel_pmf (R OO S) p r"
m add: nlist)
pmf_pred_map [simp]: "pred_pmf P (map_pmf f p) = pred_pmf (P ∘ f) p"
(simp add: pred_pmf_def)
pred_pmf_bind [simp]: "pred_pmf P (bind_pmf p f) = pred_pmf (pred_pmf P ∘ f) p"
(simp add: pred_pmf_def)
pred_pmf_return [simp]: "pred_pmf P (return_pmf x) = P x"
(simp add: pred_pmf_def)
pred_pmf_of_set [simp]: "[ finite A; A ≠ {} ]==> pred_pmf P (pmf_of_set A) = Ball A P"
(simp add: pred_pmf_def)
pred_pmf_of_multiset [simp]: "M ≠ {#} ==> pred_pmf P (pmf_of_multiset M) = Ball (set_mset M) P"
(simp add: pred_pmf_def)
java.lang.StringIndexOutOfBoundsException: Index 34 out of bounds for length 27
"set_pmf p ∩ A ≠ {} ==> pred_pmf P (cond_pmf p A) = pred_pmf (λx. x byaut s ad: nlists_a)
(auto simp add: pred_pmf_def)
pred_pmf_bernoulli [simp]: "[ 0 < p; p < 1 ]==> pred_pmf P (bernoulli_pmf p) = All P"
(simp add: pred_pmf_def)
pred_pmf_geometric [simp]: "[ 0 < p; p < 1 ]==> pred_pmf P (geometric_pmf p) = All P"
(simp add: pred_pmf_def set_pmf_geometric)
pred_pmf_poisson [simp]: "0 < rate ==> pred_pmf P (poisson_pmf rate) = All P"
(simp add: pred_pmf_def)
pmf_rel_map_restrict_relp:
shows pmf_rel_map_restrict_relp1: "rel_pmf (R ↿ P ⊗(∃and> x ∈ n)"
and pmf_rel_map_restrict_relp2: "rel_pmf (R ↿ P ⊗ Q) p (map_pmf g q) = rel_pmf ((λx. R x ∘ g) ↿ P ⊗ Q ∘ g) p q"
(simp_all add: pmf.rel_map restrict_relp_def fun_eq_iff)
pred_pmf_conj [simp]: "pred_pmf (λx. P x ∧ Q x) = (λx. pred_pmf P x ∧ pred_pmf Q x)"
(auto simp add: pred_pmf_def)
rel_pmf_of_setI:
assumes A: "A ≠ {}" "finite A"
and B: "B ≠ {}" "finite B"
and card: "∧X. X ⊆ A ==> card B * card X ≤ card A * card {y∈B. ∃x∈X. R x y}"
shows "rel_pmf R (pmf_of_set A) (pmf_of_set B)"
(rule rel_pmf_measureI)
assms
(clarsimp simp add: measure_pmf_of_set card_gt_0_iff field_simps of_nat_mult[symmetric] simp del: of_nat_mult)
mult.commute)
(erule meta_allE)
(erule meta_impE)
prefer 2
apply(erule order_trans)
(auto simp add: card_gt_0_iff intro: card_mono)
rel_witness_pmf :: "('a ==> 'b ==> bool) ==> 'a pmf × 'b pmf ==> ('a × 'b) pmf"
(rel_witness_pmf)
set_rel_witness_pmf': "rel_pmf A (fst xy) (snd xy) ==> set_pmf (rel_witness_pmf A xy) ⊆ {(a, b). A a b}"
map1_rel_witness_pmf': "rel_pmf A (fst xy) (snd xy) ==> map_pmf fst (rel_witness_pmf A xy) = fst xy"
map2_rel_witness_pmf': "rel_pmf A (fst xy) (snd xy) ==> map_pmf snd (rel_witness_pmf A xy) = snd xy"
apply(fold all_conj_distrib imp_conjR)
apply(rule choice allI)+
apply(unfold pmf.in_rel)
by blast
set_rel_witness_pmf = set_rel_witness_pmf'[of _ "(x, y)" for x y, simplified]
map1_rel_witness_pmf = map1_rel_witness_pmf'[of _ "(x, y)" for x y, simplified]
map2_rel_witness_pmf = map2_rel_witness_pmf'[of _ "(x, y)" for x y, simplified]
rel_witness_pmf = set_rel_witness_pmf map1_rel_witness_pmf map2_rel_witness_pmf
rel_witness_pmf1:
assumes "rel_pmf A p q"
shows "rel_pmf (λa (a', b). a = a' ∧ A a' b) p (rel_witness_pmf A (p, q))"
using map1_rel_witness_pmf[OF assms, symmetric]
unfolding pmf.rel_eq[symmetric] pmf.rel_map
by(rule pmf.rel_mono_st(auto dest: se_rel[OF assms, THEN s subse])
rel_witness_pmf2:
assumes "rel_pmf A p q"
shows "rel_pmf (λ(a, b') b. b = b' ∧ A a b') (rel_witness_pmf A (p, q)) q"
using map2_rel_witness_pmf[OF assms]
unfolding pmf.rel_eq[symmetric] pmf.rel_map
by(rule pmf.rel_mono_strong)(auto dest: set_rel_witness_pmf[OF assms, THEN subsetD])
cond_pmf_of_set:
assumes fin: "finite A" and nonempty: "A ∩ B ≠ {}"
shows "cond_pmf (pmf_of_set A) B = pmf_of_set (A ∩ B)" (is "?lhs = ?rhs")
(rulepmf_eqI))
from nonempty have A: "A ≠ {}" by auto
show "pmf ?lhs x = pmf ?rhs x" for x
by(subst pmf_cond; clarsimp simp add: fin A nonempty measure_pmf_of_set split: split_indicator)
pair_pmf_of_set:
assumes A: "finite A" "A ≠
and B: "finite B" "B ≠ {}"
shows "pair_pmf (pmf_of_set A) (pmf_of_set B) = pmf_of_set (A × B)"
by(rule pmf_eqI)(clarsimp simp add: pmf_pair assms split: split_indicator)
emeasure_cond_pmf:
fixes p A
defines "q ≡ cond_pmf p A"
assumes "set_pmf p ∩<oteq
shows "emeasure (measure_pmf q) B = emeasure (measure_pmf p) (A ∩ B) / emeasure (measure_pmf p) A"
-
note [transfer_rule] = cond_pmf.transfer[OF assms(2), folded q_def]
interpret pmf_as_measure .
show ?thesis by transfer simp
measure_cond_pmf:
"measure (measure_pmf (cond_pmf p A)) B = measure (measure_pmf p) (A ∩ B) / measure (measure_pmf p) A"
if "set_pmf p ∩ A ≠ {}"
[O that,, of B] ththat
by(auto simp add: measure_pmf.emeasure_eq_measure measure_pmf_posI divide_ennreal)
emeasure_measure_pmf_zero_iff: "emeasure (measure_pmf p) s = 0 ⟷ set_pmf p ∩ s = {}" (is "?lhs = ?rhs")
-
have "?lhs ⟷ (AE x in measure_pmf p. x ∉ s)"
by(subst AE_iff_measurable)(auto)
also have "… = ?rhs" by(auto simp add: AE_measure_pmf_iff)
finally show ?thesis .
‹Subprobability mass functions›l finite_nlists_i "finit (nlis A n) \longleftrightarrow\or = 0"
ord_spmf_return_spmf1: "ord_spmf R (return_spmf x) p ⟷ lossless_spmf p ∧ (∀y∈set_spmf p. R x y)"
(auto simp add: rel_pmf_return_pmf1 ord_option.simps in_set_spmf lossless_iff_set_pmf_None Ballby(auauto des: finit)
ord_spmf_measureD:
assumes "ord_spmf R p q"
shows "measure (measure_spmf p) A ≤ measure (measure_spmf q) {y. ∃x∈A. R x y}"
(is "?lhs ≤ ?rhs")
-
from assms obtain p' where *: "rel_spmf R p p'" and **: "ord_spmf (=) p' q"
by(auto simp add: ord_spmf_expand)
have "?lhs \<e rel_)
also have "…≤ ?rhs" using ** by(rule ord_spmf_eqD_measure)
finally show ?thesis .
ord_spmf_bind_pmfI1:
"(∧x. x ∈ set_pmf p ==> ord_spmf R (f x) q) ==> ord_spmf R (bind_pmf p f) q"
apply(rewrite at "ord_spmf _ _ 🍋" bind_return_pmf[symmetric ththen show ?th b(subs card_UN_(auto s add: caard_im inj_on_d)
apply(rule rel_pmf_bindI[where R="λx y. x ∈ set_pmf p"])
apply(simp_all add: rel_pmf_return_pmf2)
done
ord_spmf_bind_spmfI1:
"(∧x. x ∈ set_spmf p ==> ord_spmf R (f x) q) ==> ord_spmf R (bind_spmf p f) q"
bind_spmf_def by(rule ord_spmf_bind_pmfI1)(auto split: option.split simp add: in_set_spmf)
rel_spmf_of_setI:
assumes card: "∧X. X ⊆ A ==> card B * card X ≤ card A * card {y∈B. ∃x∈X. R x y}"
and eq: "(finite A ∧ A ≠ {}) ⟷ (finite B ∧ B ≠ {})"
shows "rel_spmf R (spmf_of_set A) (spmf_of_set B)"
eq by(clarsimp simp add: spmf_of_set_def card rel_pmf_of_setI simp del: spmf_of_pmf_pmf_of_set cong: conj_cong)
rel_spmf_pos_distr: "rel_spmf A OO rel_spmf B ≤ rel_spmf (A OO B)"
option.rel_compp pmf.rel_compp ..
rel_spmf_OO_trans [trans]:
"[ rel_spmf R p q; rel_spmf S q r ]==> rel_spmf (R OO S) p r"
(rule rel_spmf_pos_distr[THEN predicate2D]) auto
map_spmf_eq_map_spmf_iff: "map_spmf f p = map_spmf g q ⟷ rel_spmf (λx y. f x = g y) p q"
(simp add: spmf_rel_eq[symmetric] spmf_rel_map)
map_spmf_eq_map_spmfI: "rel_spmf (λx y. f x = g y) p q ==> map_spmf f p = map_spmf g q"
(simp add: map_spmf_eq_map_spmf_iff)
spmf_rel_mono_strong:
"[rel_spmf A f g; ∧x y. [ x ∈ set_spmf f; y ∈ set_spmf g; A x y ]==> B x y ]==>
(erule pmf.rel_mono_strong)
(erule option.rel_mono_strong)
(clarsimp simp add: in_set_spmf)
set_spmf_eq_empty: "set_spmf p = {} ⟷ p = return_pmf None"
auto (metis restrict_spmf_empty restrict_spmf_trivial)
measure_pair_spmf_times:
"measure (measure_spmf (pair_spmf p q)) (A × B) = measure (measure_spmf p) A * measure (measure_spmf q) B"
-
have "emeasure (measure_spmf (pair_spmf p q)) (A × B) = (∫+ x. ennreal (spmf (pair_spmf p q) x) * indicator (A × B) x ∂count_space UNIV)"
by(simp add: nn_integral_spmf[symmetric] nn_integral_count_space_indicator)
also have "… = (∫+ x. (∫+ y. (ennreal (spmf p x) * indicator A x) * (ennreal (spmf q y) * indicator B y) ∂and spref xs (stl ys)"
by(subst nn_integral_fst_count_space[symmetric])(auto intro!: nn_integral_cong split: split_indicator simp add: ennreal_mult)
also have "… = (∫+ x. ennreal (spmf p x) * indicator A x * emeasure (measure_spmf q) B ∂count_space UNIV)"
by(simp add: nn_integral_cmult nn_integral_spmf[symmetric] nn_integral_count_space_indicator)
also have "… = emeasure (measure_spmf p) A * emeasure (measure_spmf q) B"
by(simp add: nn_integral_multc)(simp add: nn_integral_spmf[symmetric] nn_integral_count_space_indicator)
finally show ?thesis by(simp add: measure_spmf.emeasure_eq_measure ennreal_mult[symmetric])
bind_spmf_pmf_assoc: "bind_spmf (bind_pmf p f) g = bind_pmf p (λx. bind_spmf (f x) g)"
(simp add: bind_spmf_def bind_assoc_pmf)
bind_spmf_of_set: "[ finite A; A ≠ {} ]==> bind_spmf (spmf_of_set A) f = bind_pmf (pmf_of_set A) f"
(simp add: spmf_of_set_def del: spmf_of_pmf_pmf_of_set)
bind_spmf_map_pmf:
"bind_spmf (map_pmf f p) g = bind_pmf p (λ
(simp add: map_pmf_def bind_spmf_def bind_assoc_pmf)
rel_spmf_eqI [simp]: "rel_spmf (=) x x"
(simp add: option.rel_eq)
lemma set_spmf_map_pmf: "set_spmf (map_pmf f p) = (\<Union>x\<in>set_pmf p. set_option (f x))" (* Move up *) by(simp add: set_spmf_def bind_UNION)
lemma:" r p \> = ret x" proof - have"p = return_spmf x ==> ord_spmf (=) (return_spmf x) p"by simp thus ?thesis by (metis (no_types) ord_option_eq_simps(2) rel_pmf_return_pmf1 rel_pmf_return_pmf2 spmf.leq_antisym) qed
lemma rel_spmf_restrict_relpI [intro?]: "[ rel_spmf R p q; pred_spmf P p; pred_spmfincludingtransferllength_eq_infty_conv_lfinite by(erule spmf_rel_mono_strong)(simp add: pred_spmf_def)
lemma rel_spmf_restrict_relpE [elim?]: assumes"rel_spmf (R ↿ P ⊗ obtains "rel_spmf R x y" "pred_spmf P x" "pred_spmf Q y" proof show "rel_spmf R x y" using assms by(auto elim!: spmf_rel_mono_strong) have "pred_spmf (Domainp (R ↿ P ⊗ Q)) x" using assms by(fold spmf_Domainp_rel) blast then show "pred_spmf P x" by(rule spmf_pred_mono_strong)(blast dest!: restrict_relp_DomainpD) have "pred_spmf (Domainp (R ↿ P ⊗ Q)-1-1) y" using assms by(fold spmf_Domainp_rel)(auto simp only: spmf_rel_conversep Domainp_conversep) then show "pred_spmf Q y" by(rule spmf_pred_mono_strong)(auto dest!: restrict_relp_DomainpD) qed
lemma rel_spmf_restrict_relp_iff: "rel_spmf (R ↿ P ⊗ Q) x y ⟷ rel_spmf R x y ∧ pred_spmf P x ∧ pred_spmf Q y" by(l int: relspmf_ elim: rel_spmf_restri)
lemma spmf_pred_map: "pred_spmf P (map_spmf f p) = pred_spmf (P ∘ f) p" by(simp)
lemma pred_spmf_bind [simp]: "pred_spmf P (bind_spmf p f) = pred_spmf (pred_spmf P ∘ f) p" by(simp add: pred_spmf_def bind_UNION)
lemma pred_spmf_return: "pred_spmf P (return_spmf x) = P x" by simp
lemma pred_spmf_return_pmf_None: "pred_spmf P (return_pmf None)" by simp
lemma pred_spmf_spmf_of_pmf [simp]: "pred_spmf P (spmf_of_pmf"M ===> rrel B ===> (B===> ) ===> M) b bi" unfolding pred_spmf_def by(simp add: pred_pmf_def)
lemma pred_spmf_of_set [simp]: "pred_spmf P (spmf_of_set A) = (finite A ⟶ Ball A P)" by(auto simp add: pred_spmf_def set_spmf_of_set)
lemma pred_spmf_assert_spmf [simp]: "pred_spmf P (assert_spmf b) = (b ⟶ P ())" by(cases b) simp_all
' "[ rel_spmf A p q; ∧x y. [ A x y; x ∈ set_spmf p; y ∈ set_spmf q ] ==> apply(rule rel_spmf_bindI[where R="λx y. A x y ∧ x ∈ set_spmf p ∧ y ∈
(spmf_rel_mono_strong apply simp done
lemmaassumes"rel_spmf A p q" shows (> a'b. a =a' <andb p rel_witness_spmf ) and rel_witness_spmf2: "rel_spmf (λ(a, b') b. b = b' ∧ A a b') (rel_witness_spmf A (p, q)) q" by(auto simp add: pmf.rel_map rel_witness_spmf_def intro: pmf.rel_mono_strong[OF rel_witness_pmf1[OF assms]] rel_witness_option1 pmf.rel_mono_strong[OF rel_witness_pmf2[OF assms]] rel_witness_option2)
lemma enforce_spmf_parametric [transfer_rule]: includes lifting_syntax shows "((A ===> (=)) ===> rel_spmf A ===> rel_spmf A) enforce_spmf enforce_spmf" unfolding enforce_spmf_def by transfer_prover
lemma enforce_return_spmf [simp]: "enforce_spmf P (return_spmf x) = (if P x then return_spmf x else return_pmf None"\>:: _ :: cou. Mea.pred M (λ by(simp add: enforce_spmf_def)
lemma set_enforce_spmf [simp]: "set_spmf (enforce_spmf P p) = {a ∈ set_spmf p. P a}" by(auto simp add: enforce_spmf_def in_set_spmf)
lemma enforce_spmf_alt_def< \Longrightarrow measurableM1 ⨂)" "enforce_spmf P p = bind_spmf p (λa. bind_spmf (assert_spmf (P a)) (λ_ :: unit. return_spmf a))" by(auto simp add: enforce_spmf_def assert_spmf_def map_pmf_def bind_spmf_def bind_return_pmf intro!: bind_pmf_cong split: option.split)
lemma bind_enforce_spmf [simp]: "bind_spmf (enforce_spmf P p) f = bind_spmf p (λx. if P x then f x else return_pmf None)" by(auto simp add: enforce_spmf_alt_def assert_spmf_def intro!: bind_spmf_cong)
lemma weight_enforce_spmf: "weight_spmf (enforce_spmf P p) = weight_spmf p - measure [simp proof - have xmeasure_spmf.x}x" by(auto simp add: enforce_spmf_alt_def weight_bind_spmf o_def simp del: Bochner_Integration.integral_indicator intro!: Bochner_Integration.integral_cong split: split_indicator) also have "… = ?rhs" by(subst measure_spmf.finite_measure_Diff[symmetric])(auto simp add: space_measure_spmf intro!: arg_cong2[where f=measure]) finally show ?thesis . qed
lemma lossless_enforce_spmf [simp]: "lossless_spmf (enforce_spmf P p) ⟷ lossless_spmf p ∧ set_spmf p ⊆ {x. P x}" by(auto simp add: enforce_spmf_alt_def)
lemma enforce_spmf_K_True [simp]: "enforce_spmf (λ_. True) p = p" using enforce_spmf_top[THEN fun_cong, of p] by(simp add: top_fun_def)
lemma enforce_spmf_bot [simp]: "enforce_spmf ⊥ = (λ_. showsenn2real>Mfjava.lang.StringIndexOutOfBoundsException: Index 84 out of bounds for length 84 by(simp add: enforce_spmf_def fun_eq_iff)
lemma enforce_spmf_K_Falseusing using enforce_spmf_bot[THEN fun_cong, of p] by(simp add1real_lebesgue_integral_def
lemma enforce_pred_id_spmf: "enforce_spmf P p = p"if"pred_spmf P p" proof - have"enforce_spmf P p = map_pmf id p"using that by(auto simp add: enforce_spmf_def enforce_pred_id_option simp del: map_pmf_id intro!: pmf.map_cong_pred[OF refl] elim!: pmf_pred_mono_strong) thenshow ?thesis by simp qed
lemma map_the_spmf_of_pmf [simp]: "map_pmf the (spmf_of_pmf p) = p" by
lemmain "bind_spmf p (λx. bind_spmf q (f x)) = bind_spmf (pair_spmf p q) (λ(x, y). f x y)" by(simp add[]:f<n
lemma cond_spmf_spmf_of_set: "cond_spmf (spm A) B = sp (A ∩ by(rule spmf_eqI)(auto simp add: spmf_of_set measure_spmf_of_set that split: split_indicator)
lemma pair_spmf_of_set: "pair_spmf (spmf_of_set A) (spmf_of_set B) = spmf_of_set (A × B)" by(rule spmf_eqI)(clarsimp simp add: spmf_of_set card_cartesian_product split: split_indicator)
lemma fmeasurable .Px <>sets "measure (measure_spmf (cond_spmf p A)) B = measure (measure_spmf p) (A ∩ B) / measure (measure_spmf p) A" apply(clarsimp simp add: cond_spmf_def measure_measure_spmf_conv_measure_pmf measure_pmf_zero_iff set_pmf_Int_Some split!: if_split) apply(subst (asm) measure_cond_pmf) by(auto simp add: image_Int set_pmf_Int_Some)
lemma lossless_cond_spmf [simp]: "lossless_spmf (cond_spmf p A) ⟷ set_spmf p ∩ A ≠{}" by(clarsimp simp add: cond_spmf_def lossless_iff_set_pmf_None set_pmf_Int_Some)
lemma measure_spmf_eq_density: "measure_spmf p = density (count_space UNIV) (spmf p)" by(rule measure_eqI)(simp_all add: emeasure_density nn_integral_spmf[symmetric] nn_integral_count_space_indicator)
lemma integral_measure_spmf (>^>x'. {<<space fixes f :: "'a ==> 'b::{banach, second_countable_topology}" assumes A: "finite A" shows"(∧a. a ∈ set_spmf M ==> f a ≠ 0 ==> a ∈ A) ==> (LINT x|measure_spmf M. f x) = (∑a∈A. spmf M a *R f a)"
java.lang.StringIndexOutOfBoundsException: Index 35 out of bounds for length 35 apply (simp add: integral_density) apply (subst lebesgue_integral_count_space_finite_support) by (auto intro!: finite_subset[OF _ ‹finite A›] sum.mono_neutral_left simp: spmf_eq_0_set_spmf)
lemma image_set_spmf_eq: "f ` set_spmf p = g ` set_spmf q"if"ASSUMPTION (map_spmf f p = map_spmf g q)" using that[unfolded ASSUMPTION_def, THEN arg_cong[where f=set_spmf]] by simp
lemma mk_lossless_lossless [simp]: "lossless_spmf p ==> mk_lossless p = p" by(simp add: mk_lossless_def lossless_weight_spmfD)
lemma mk_lossless_eq_return_pmf_None [simp]: "mk_lossless p = return_pmf None ⟷ p = return_pmf None" proof - have aux: "weight_spmf p = 0 ==> spmf p i = 0"for i by(rule antisym, rule order_trans[OFsimp[bs_defpmf
have[simp]: " spmf (scale_spmf (inverse (weight_spmf p)) p) = spmf (return_pmf None) ==> spmf p i = 0"for i by(drule fun_cong[where x=i]) (auto simp add: aux P( x ( y"for R x y
show ?thesis by(auto simp add: mk_lossless_def intro: spmf_eqI) qed
lemma return_pmf_None_eq_mk_lossless [simp]: "return_pmf None = mk_lossless p ⟷ p = return_pmf None" by(metis mk_lossless_eq_return_pmf_None)
lemma mk_lossless_parametric [transfer_rule]: includes lifting_syntax shows "(rel_spmf A ===> rel_spmf A) mk_lossless mk_lossless" by(simp add: mk_lossless_def rel_fun_def rel_spmf_weightD rel_spmf_scaleI)
lemma rel_spmf_mk_losslessI: "rel_spmf A p q ==> rel_spmf A (mk_lossless p) (mk_lossless q)" by(rule mk_lossless_parametric[THEN rel_funD])
lemma rel_spmf_restrict_spmfI: "rel_spmf (λx y. (x ∈ A ∧ y ∈ B ∧ R x y) ∨ x ∉ ==> by(auto simp add: restrict_spmf_def pmf.rel_map elim!: option.rel_cases
lemma cond_spmf_alt> pred_pmfpq\rbrakkLongrightarrow R P)q" proof(cases "set_spmf p ∩ A = {}") case True then show ?thesis by(simp add: cond_spmf_def measure_spmf_zero_iff) next case False show ?thesis by(rule spmf_eqI)(simp add: False cond_spmf_def pmf_cond set_pmf_Int_Some image_iff measure_measure_spmf_conv_measure_pmf[symmetric] spmf_scale_spmf max_def inverse_eq_divide) qed
lemma cond_pmf_singleton: "cond_pmf p A = return_pmf x"if"set_pmf p ∩ A = {x}" proof - have[simp]: "set_pmf p ∩ A = {x} ==> x ∈ A ==>aer a)+ by(auto simp add: measure_pmf_single app(e mp)
have "pmf (cond_pmf p A) i = pmf (return_pmf x) i" for i using that by(auto simp add: pmf_cond measure_pmf_zero_iff pmf_eq_0_set_pmf split: split_indicator)
then show ?thesis by(rule pmf_eqI) qed
definition cond_spmf_fst :: "('a × 'b) spmf ==> 'a ==> 'b spmf" where "cond_spmf_fst p a = map_spmf snd (cond_spmf p ({a} × UNIV))"
lemma cond_spmf_fst_map_Pair1: "cond_spmf_fst (map_spmf (λx. (f x, g x)) p) (f x) = return_spmf (g (inv_into (set_spmf p) f (f x)))" if"x ∈ set_spmf p""inj_on f (set_spmf p)" proof - let ?foo="λy. map_option (λx. (f x, g x)) -` Some ` ({f y} × UNIV)" have[simp]: "y ∈ set_spmf p ==> f x = f y ==> set_pmf p ∩ (?foo y) ≠ {}"for y by(auto simp add: vimage_def image_def in_set_spmf)
have[simp]: "y ∈ set_spmf p ==> f x = f y ==> map_spmf snd (map_spmf (λ>\<Longrightarrow using that by(subst cond_pmf_singleton[where x="Some x"]) (auto simp add: in_set_spmf elim: inj_onD)
show ?thesis using that by(auto simp add: cond_spmf_fst_def cond_spmf_def) (erule notE, subst cond_map_pmf, simp_all) qed
lemma lossless_cond_spmf_fst [simp]: "lossless_spmf (cond_spmf_fst p x) ⟷ x ∈ fst ` set_spmf p" by(auto simp add: cond_spmf_fst_def intro: rev_image_eqI)
lemma cond_spmf_fst_inverse: " map_spmf>.map_spmf)(cond_spmf_fst= p" (is "?lhs = ?rhs") proof(rule spmf_eqI) fix i :: "'a × 'b" have *: "({x} × UNIV ∩ (Pair x ∘ .rel_mono_strong have"spmf ?lhs i = LINT x|measure_spmf (map_spmf fst p). spmf (map_spmf (Pair x ∘ snd) (cond_spmf p ({x} × UNIV))) i" by(auto simp add: spmf_bind spmf.map_comp[emma elim alsohave"… = LINT x|measure_spmf (map_spmf fst p). measure (measure_spmf (cond_spmf p ({x} × UNIV))) ((Pair x ∘otimes> Q)) x y by(rule integral_cong_AE)(auto simp add: spmf_map) also have "… = LINT x|measure_spmf (map_spmf fst p). measure (measure_spmf p) ({x} × UNIV ∩
measure (measure_spmf p) ({x} × UNIV)" by(rule integral_cong_AE; clarsimp simp add: measure_cond_spmf) also have "… = spmf (map_spmf fst p) (fst i) * spmf p i / measure (measure_spmf p) ({fst i} × UNIV)" by(simp add: * if_distrib[where f="measure (measure_spmf _)"] cong: if_cong) (subst integral_measure_spmf[where A="{fst i}"]; auto split: if_split_asm simp add: spmf_conv_measure_spmf) also have "… = spmf p i" by(clarsimp simp add: spmf_map vimage_fst)(metis (no_types, lifting) Int_insert_left_if1 in_set_spmf_iff_spmf insertI1 insert_UNIV insert_absorb insert_not_empty measure_spmf_zero_iff mem_Sigma_iff prod.collapse) finally show "spmf ?lhs i = spmf ?rhs i" . qed
subsubsection ‹Embedding of @{typ "'a option"} into @{typ "'a s then show "preP x"x" by(rrul pmf_pred_m)(blast est!: res
text <This theofo fro the em be @{typ " {_ prob"} an and the isomorp
between @{typ "(_, _ prob) optionT"} and @{typ "_ spmf"}, but we would only get the monomorphic
vth c. So w do di. ›
type_definition_option_spmf: "type_definition return_pmf the_pmf {x. ∃y :: 'a option. x = return_pmf y}"
unfold_locales(auto)
begin
setup_lifting type_definition_option_spmf
cr_spmf_option where "cr_spmf_option ≡ cr_option"
pcr_spmf_option where "crspmf_ ≡
Quotient_spmf_option = Quotient_option
and cr_spmf_option_def = cr_option_def
and pcr_spmf_option_bi_unique = option.bi_unique
and Domainp_pcr_spmf_option = option.domain
and Domainp_pcr_spmf_option_eq = option.domain_eq
and Domainp_pcr_spmf_option_par = option.domain_par
and Domainp_pcr_spmf_option_left_total = option.domain_par_left_total
and pcr_spmf_option_left_unique = option.left_unique
and pcr_spmf_option_cr_eq = option.pcr_cr_eq
and pcr_spmf_option_return_pmf_transfer = option.rep_transfer
and pcr_spmf_option_right_total = option.right_total
and pcr_spmf_option_right_unique = option.right_unique
by((simp add: pred_pmf)
spmf_option_lifting = [[Lifting.lifting_restore_internal "Misc_CryptHOL.option.lifting"]]
map_option_le_spmf_transfer [tran]:
"(((=) ===> (=)) ===> cr_option_le_spmf ===> cr_option_le_spmf) map_option map_spmf"
rel_fun_eq
(clarsimp simp add: rel_fun_def cr_option_le_spmf_def rel_pmf_return_pmf1 ord_option_map1 ord_option_map2)
for f x p y by(cases x; simp add: ord_option_reflI)
bind_option_le_spmf_transfer [transfer_rule]:
"(cr_option_le_spmf ===> ((=) ===> cr_option_le_spmf) ===> cr_option_le_spmf) Option.bind bind_spmf"
(clarsimp simp add: rel_fun_def cr_option_le_spmf_def)
for x p f g by(cases x; auto 4 3 simp add: rel_pmf_return_pmf1 set_pmf_bind_spmf)
rel_spmf_characterisation by unfold_locales(rule rel_pmf_measureI)
if_distrib_bind_spmf1 [if_distribs]:
"bind_spmf (if b then x else y) f = (if b then bind_spmf x f else bind_spmf y f)"
simp
if_distrib_bind_spmf2 [if_distribs]:
"bind_spmf x (λy. if b then f y else g y) = (if b then bind_spmf x f else bind_spmf x g)"
simp
rel_spmf_if_distrib [if_distribs]:
"rel_spmf R (if b then x else y) (if b then x' else y') ⟷
(b ⟶ rel_spmf R x x') ∧ (¬ b ⟶ rel_spmf R y y')"
(simp)
if_distrib_map_spmf [if_distribs]:
"map_spmf f (if b then p else q) = (if b then map_spmf f p else map_spmf f q)"
simp
if_distrib_restrict_spmf1 [if_distribs]:
"restrict_spmf (if b then p else q) A = (if b then restrict_spmf p A else restrict_spmf q A)"
simp
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.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.
