‹ I'm not completely satisfied with partial functions as provided by Map.thy, since they don't
have a unique type and so we can't instantiate classes, make use of adhoc-overloading
etc. Consequently I've created a new type and derived the laws. ›
graph_pfun :: "('a × 'b) set ==> ('a, 'b) pfun" is "graph_map ∘ mk_functional" .
pfun_pfun :: "'a set ==> 'b set ==> ('a 🍋 'b) set" where
pfun_pfun A B = {f :: 'a 🍋 'b. pdom(f) ⊆ A ∧ pran(f) ⊆ B}"
pfun_tfun :: "'a set ==> 'b set ==> ('a 🍋 'b) set" where
pfun_tfun A B = {f ∈ pfun_pfun A B. pdom(f) = UNIV}"
pfun_ffun :: "'a set ==> 'b set ==> ('a 🍋 'b) set" where
pfun_ffun A B = {f ∈ pfun_pfun A B. finite(pdom(f))}"
pfun_pinj :: "'a set ==>‹
pfun_pinj A B = {f ∈ pfun_pfun A B. pfun_inj f}"
pfun_psurj :: "'a set ==> 'b set ==> ('a 🍋 'b) set" where
pfun_psurj A B = {f ∈ pfun_pfun A B. pran(f) = UNIV}"
"pfun_finj A B = pfun_ffun A B ∩ pfun_pinj A B"
"pfun_tinj A B = pfun_tfun A B ∩ pfun_pinj A B"
"pfun_tsurj A B = pfun_tfun A B ∩ pfun_psurj A B"
"pfun_bij A B = pfun_tfun A B ∩ pfun_pinj A B ∩ pfun_psurj A B"
pfun_entries :: "'k set ==> ('k ==> 'v) ==> ('k, 'v) pfun" is
λ d f x. if x ∈ d then Some (f x) else None" .
pfuse :: "('a 🍋 'b) ==> ('a 🍋 'c) ==> ('a 🍋 'b × 'c)"
where "pfuse f g = pfun_entries (pdom(f) ∩ pdom(g)) (λ x. (pfun_app f x, pfun_app g x))"
ptabulate :: "'a list ==> ('a ==> 'b) ==> ('a, 'b) pfun"
is "λks f. (map_of (List.map (λk. (k, f k)) ks))" .
lift_definition less_eq_pfun :: "('a, 'b) pfun ==> ('a, 'b) pfun ==> bool" is
"λ f g. f ⊆m g" .
lift_definition less_pfun :: "('a, 'b) pfun ==> ('a, 'b) pfun ==> bool" is
"λ f g. f ⊆m g ∧ f ≠ g" .
by (intro_classes, (transfer, auto intro: map_le_trans simp add: map_le_antisym)+)
"_PfunUpd m (_Maplets xy ms)" == "_PfunUpd (_PfunUpd m xy) ms"
"_PfunUpd m (_maplet x y)" == "CONST pfun_upd m x y"
"_Pfun ms" => "_PfunUpd (CONST pempty) ms"
"_Pfun (_Maplets ms1 ms2)" <= "_PfunUpd (_Pfun ms1) ms2"
"_Pfun ms" <= "_PfunUpd (CONST pempty) ms"
"_pabs x A P f" => "CONST pabs A (λ x. P) (λ x. f)"
"_pabs x A P f" <= "CONST pabs A (λ y. P) (λ x. f)"
"_pabs x A P (f x)" <= "CONST pabs A (λ x. P) f"
"_pabs_mem x A f" == "_pabs x A (CONST True) f"
"_pabs_pred x P f" == "_pabs x (CONST UNIV) P f"
"_pabs_tot x f" == "_pabs_pred x (CONST True) f"
"_pabs_tot x f" <= "_pabs_mem x (CONST UNIV) f"
pfun_minus_unit [simp]:
fixes f :: "('a, 'b) pfun"
shows "f - ⊥ = f"
by (transfer, simp add: map_minus_def)
pfun_minus_zero [simp]:
fixes f :: "('a, 'b) pfun"
shows "⊥ - f = ⊥"
by (transfer, simp add: map_minus_def)
pfun_minus_self [simp]:
fixes f :: "('a, 'b) pfun"
shows "f - f = ⊥"
by (transfer, simp add: map_minus_def)
pfun :: (type, type) override
definition compatible_pfun :: "'a 🍋 'b ==> 'a 🍋 'b ==> bool" where
"compatible_pfun R S = ((pdom R) ⊲p S = (pdom S) ⊲p R)"
pfun_compat_add: "(P :: 'a 🍋 'b) ## Q ==> P ⊕ Q ## R ==> P ## R"
apply (simp add: compatible_pfun_def oplus_pfun_def)
apply (transfer)
using map_compat_add apply auto
done
pfun_compat_addI: "[ (P :: 'a 🍋 'b) ## Q; P ## R; Q ## R ]==> P ⊕ Q ## R"
apply (simp add: compatible_pfun_def oplus
apply (transfer)
apply (simp add: restrict_map_def fun_eq_iff dom_def map_add_def option.case_eq_if)
apply metis
done
proof
fix P Q R :: "'a 🍋 'b"
show "P ## Q ==> P ⊕ Q ## R ==> P ## R"
using pfun_compat_add by blast
show "P ## Q ==> P ## R ==> Q ## R ==> P ⊕ Q ## R"
by (simp add: pfun_compat_addI)
(simp_all add: compatible_pfun_def oplus_pfun_def,
(transfer, auto simp add: map_add_subsumed2 map_add_comm_weak')+)
pfun_indep_compat: "pdom(f) ∩ pdom(g) = {} ==> f ## g"
unfolding compatible_pfun_def
by (transfer, auto simp add: restrict_map_def fun_eq_iff)
pfun_override_commute:
"pdom(f) ∩ pdom(g) = {} ==> f ⊕ g = g ⊕ f"
by (transfer, metis map_add_comm)
pfun_override_commute_weak:
"(∀ k ∈ pdom(f) ∩using "∀
by (transfer, simp, metis IntD1 IntD2 domD map_add_comm_weak option.sel)
pfun_override_fully: "pdom f ⊆ pdom g ==> f ⊕ g = g"
by (transfer, auto simp add: map_add_def option.case_eq_if fun_eq_iff)
pfun_override_res: "pdom g -⊲p f ⊕ g = f ⊕ g"
by (transfer, auto simp add: map_add_restrict[THEN sym])
pfun_app_add' [simp]: "e ∉ pdom g ==> (f ⊕ g)(e)p = f(e)p"
by (transfer, auto)
pfun_upd_twice [simp]: "f(x ↦ u, x ↦ v)p = f(x ↦ v)p"
by (transfer, simp)
pfun_upd_comm:
assumes "x ≠ y"
shows "f(y ↦ u, x ↦ v)p = f(x ↦ v, y ↦ u)p"
using assms by (transfer, auto)
pfun_upd_comm_linorder [simp]:
fixes x y :: "'a :: linorder"
assumes "x < y"
shows "f(y ↦ u, x ↦ v)p = f(x ↦ v, y ↦ u)p"
using assms by (transfer, auto)
pfun_upd_as_ovrd: "f(k ↦ v)p = f ⊕ {k ↦ v}C1: : \openfo ([F] \rightarrow\exists>! ([]v Ru))›
by (transfer, simp)
pfun_ovrd_single_upd: "x ∈ pdom(g) ==> f ⊕ ({x} ⊲p g) = f(x ↦ g(x)p)p"
by (transfer, auto simp add: map_add_def restrict_map_def fun_eq_iff)
pfun_app_minus [simp]: "x ∉ pdom g ==> (f - g)(x)p = f(x)p"
by (transfer, auto simp add: map_minus_def)
pfun_app_empty [simp]: "{}p(x)p = undefined"
by (transfer, simp)
pfun_graph_comp: "pfun_graph (f ∘p g) = pfun_graph g O pfun_graph f"
by (transfer, simp add: map_graph_comp)
comp_pfun_graph: "pfun_graph f O pfun_graph g = pfun_graph (g ∘p f)"
by (simp add: pfun_graph_comp)
pfun_graph_pfun_inv: "pfun_inj f ==> pfun_graph (pfun_inv f) = (pfun_graph f)-1"
by (transfer, simp add: map_graph_map_inv)
pfun_graph_pabs: "pfun_graph (λ x ∈ A | P x ∙ f x) = {(k, v). k ∈ A ∧ P k ∧ v = f k}"
unfolding pabs_def by (transfer, auto simp add: map_graph_def restrict_map_def)
pfun_graph_le_iff:
"pfun_graph f ⊆ pfun_graph g ⟷ f ⊆p g"
s ad: .ordpfun_eq_grapfun_graph_i)
pfun_member_iff [simp]: "(k, v) ∈ pfun_graph f ⟷ (k ∈ pdom(f) ∧ pfun_app f k = v)"
by (transfer, auto simp add: map_graph_def)
pfun_graph_rres: "pfun_graph (f ⊳p A) = pfun_graph f ⊳r A"
by (transfer, auto simp add: map_graph_def rel_ranres_def ran_restrict_map_def)
‹ Graph Transfer Setup ›
cr_pfung :: "('a ↔ 'b) ==> 'a 🍋 'b ==> bool" where
cr_pfung f g = (f = pfun_graph g)"
pdom_res_zero [simp]: "A ⊲p {}p = {}p"
by (transfer, auto)
pdom_res_empty [simp]:
"({} ⊲p f) = {}p"
by (transfer, auto)
pdom_res_pdom [simp]:
"pdom(f) ⊲p f = f"
by (transfer, auto)
pdom_res_UNIV [simp]: "UNIV ⊲p f = f"
by (transfer, auto)
pdom_res_alt_def: "A ⊲p f = f ∘p pId_on A"
by (transfer, rule ext, auto simp add: restrict_map_def)
pdom_res_upd_in [simp]:
"k ∈ A ==> A ⊲p f(k ↦ v)p = (A ⊲p f)(k ↦ v)p"
by (transfer, auto)
pdom_res_upd_out [simp]:
"k ∉ A ==> A ⊲p f(k ↦ v)p = A ⊲and ‹
by (transfer, auto)
pfun_pdom_antires_upd [simp]:
"k ∈ A ==> ((- A) ⊲p m)(k ↦ v)p = ((- (A - {k})) ⊲p m)(k ↦ v)p"
by (transfer, simp)
pdom_antires_insert_notin [simp]:
"k ∉ pdom(f) ==> (- insert k A) ⊲p f = (- A) ⊲p f"
by (transfer, auto simp add: restrict_map_def)
pdom_res_override [simp]: "A ⊲p (f ⊕ g) = (A ⊲p f) ⊕ (A ⊲p g)"
by (simp add: pdom_res_alt_def pfun_override_dist_comp)
pdom_res_minus [simp]: "A ⊲p (f - g) = (A ⊲p f) - g"
by (transfer, auto simp add: map_minus_def restrict_map_def)
pdom_res_swap: "(A ⊲p f) ⊳p B = A ⊲p (f ⊳p B)"
by (transfer, auto simp add: restrict_map_def ran_restrict_map_def)
pdom_res_twice [simp]: "A ⊲p (B ⊲p f) = (A ∩ B) ⊲p f"
by (transfer, auto simp add: Int_commute)
pdom_res_comp [simp]: "A ⊲p (g ∘p f) = g ∘p (A ⊲p f)"
by (simp add: pdom_res_alt_def pfun_comp_assoc)
pdom_res_apply [simp]:
"x ∈ A ==> (A ⊲p f)(x)p = f(x)p"
by (transfer, auto)
pdom_res_frame_update [simp]:
"[ x ∈ pdom(f); (-{x}) ⊲p f = (-{x}) ⊲p g ]==> g(x ↦ AOT_sh<><
by transfer (metis (mono_tags, opaque_lifting) domIff fun_upd_triv fun_upd_upd option.exhaust_sel
restrict_complement_singleton_eq)
pdres_rres_commute: "A ⊲p (P ⊳p B) = (A ⊲p P) ⊳p B"
by (transfer, simp add: map_dres_rres_commute)
pdom_nres_disjoint: "pdom(f) ∩ A = {} ==> (- A) ⊲p f = f"
by (metis disjoint_eq_subset_Compl inf.absorb2 pdom_res_pdom pdom_res_twice)
pranres_pdom [simp]: "pdom (f ⊳p A) ⊲p f = f ⊳p A"
by (transfer, simp add: restrict_map_def fun_eq_iff ran_restrict_map_def option.case_eq_if)
(met(rule raa-c-cor:1")
pdom_pranres [simp]: "pdom (f ⊳p A) ⊆ pdom f"
by (metis inf.absorb_iff1 inf.commute pdom_pdom_res pdom_res_pdom pdom_res_swap)
pfun_split_domain: "A ⊲p f ⊕ (- A) ⊲p f = f"
by (transfer, auto simp add: restrict_map_def map_add_def fun_eq_iff option.case_eq_if)
‹ Range restriction laws ›
pran_re [imp]: f \<rhd\
by (transfer, simp add: ran_restrict_map_def)
pran_res_empty [simp]: "f ⊳p {} = {}p"
by (transfer, auto simp add: ran_restrict_map_def)
pran_res_zero [simp]: "{}p⊳p A = {}p"
by (transfer, auto simp add: ran_restrict_map_def)
pran_res_upd_1 [simp]: "v ∈ A ==> f(x ↦ v)p⊳p A = (f ⊳p A)(x ↦ v)p"
transfer, a simp ad ran_restrict_ap_de
pran_res_upd_2 [simp]: "v ∉ A ==> f(x ↦ v)p⊳p A = ((- {x}) ⊲p f) ⊳p A"
by (transfer, auto simp add: ran_restrict_map_def)
pran_res_twice [simp]: "f ⊳p A ⊳p B = f ⊳p (A ∩ B)"
by (transfer, simp)
pran_res_alt_def: "f ⊳p A = pId_on A ∘p f"
by (transfer, rule ext, auto simp add: ran_restrict_map_def)
pran_res_override: "(f ⊕ g) ⊳blas
by (transfer, auto simp add: map_add_def ran_restrict_map_def map_le_def option.case_eq_if)
pcomp_ranres [simp]: "(f ∘p g) ⊳p A = (f ⊳p A) ∘p g"
by (simp add: pfun_comp_assoc pran_res_alt_def)
pranres_le: "A ⊆ B ==> f ⊳p A ≤ f ⊳p B"
by (simp add: pfun_graph_le_iff[THEN sym] pfun_graph_comp pfun_graph_rres relcomp_mono rel_ranres_le)
pranres_neg_ran [simp]: "P ⊳p- pran P = {}p"
by (transfer, simp add: ran_restrict_map_def fun_eq_iff option.case_eq_if bind_eq_None_conv, meson option.exhaust_sel)
‹ Preimage Laws ›AOT_have ‹
ppreimageI [intro!]: "[ x ∈ pdom(f); f(x)p∈ A ]==> x ∈ pdom (f ⊳p A)"
by (metis (full_types) insertI1 pdom_upd pfun_upd_ext pran_res_upd_1)
ppreimageD: "x ∈ pdom (f ⊳p A) ==>∃ y ∈ A. f(x)p = y"
by (transfer, auto simp add: ran_restrict_map_def)
ppreimageE [elim!]: "[ x ∈ pdom (f ⊳p A); ∧ y. [ x ∈ pdom(f); y ∈ A; f(x)p = y ]==> P ]==> P"
by (metis (no_types) pdom_pranres ppreimageD subsetD)
mem_pimage_iff: "x ∈ pran (A ⊲p f) ⟷ (∃ y ∈ A ∩ pdom(f). f(y)p = x)"
by (auto simp add: pran_pdom)
ppreimage_inter [simp]: "pdom (f ⊳p (A ∩ B)) = pdom (f ⊳p A) ∩ pdom (f ⊳p B)"
by fastforce
‹ Composition ›
pcomp_apply [simp]: "[ x ∈ pdom(g) ]==> (f ∘p g)(x)p = f(g(x)equivE(6)"otclat1"o-cltau:3:a""
by (transfer, auto)
pcomp_mono: "[ f ≤ f'; g ≤ g' ]==> f ∘p g ≤ f' ∘p g'"
by (simp add: pfun_graph_le_iff[THEN sym] pfun_graph_comp relcomp_mono)
pdom_UNIV_comp: "pdom f = UNIV ==> pdom (f ∘p g) = pdom g"
by simp
‹ Entries ›1
pfun_entries_empty [simp]: "pfun_entries {} f = {}p"
by (transfer, simp)
pdom_pfun_entries [simp]: "pdom (pfun_entries A f) = A"
by (transfer, auto)
pran_pfun_entries [simp]: "pran (pfun_entries A f) = f ` A"
by (transfer, simp add: ran_def, auto)
pfun_entries_apply_1 [simp]:
"x ∈ d ==> (pfun_entries d f)(x)p = f x"
by (transfer, auto)
pfun_entries_apply_2 [simp]:
"x ∉ d ==> (pfun_entries d f)(x)p = undefined"
by (transfer, auto)
pdom_res_entries: "A \lhdpf B f = ppfu (A \interB "
by (transfer, auto simp add: fun_eq_iff restrict_map_def)
pfuse_empty [simp]: "pfuse {}p g = {}p"
by (simp add: pfuse_def)
pfuse_app [simp]:
"[ e ∈ pdom F; e ∈ pdom G ]==> (pfuse F G)(e)p = (F(e)p, G(e)p)"
by (metis (no_types, lifting) IntI pfun_entries_apply_1 pfuse_def)
pdom_pfuse [simp]: "pdom (pfuse f g) = pdom(f) ∩ pdom(g)"
by (auto simp add: pfuse_def)
pfuse_upd:
"pfuse (f(k ↦ v)p) g =
(if k ∈ pdom g then (pfuse ((-{k}) ⊲
by (simp add: pfuse_def, transfer, auto simp add: fun_eq_iff)
‹ Lambda abstraction ›
pabs_cong:
assumes "A = B" "∧ x. x ∈ A ==> P(x) = Q(x)" "∧ x. [ x ∈ A; P x ]==> F(x) = G(x)"
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
using assms unfolding pabs_def
by (transfer, auto simp add: restrict_map_def fun_eq_iff)
pabs_apply [simp]: "[ y ∈ A; P y ]==> (λ x ∈ A | P x ∙ f x) (y)p = f y"
by (simp add: pabs_def)
pdom_pabs [simp]: "pdom (λ x ∈ A | P x ∙ f x) = A ∩ Collect P"
by (simp add: pabs_def)
pran_pabs [simp]: "pran (λ x ∈ A | P x ∙ f x) = {f x | x. x ∈ A ∧ P x}"
unfolding pabs_de
by (transfer, auto simp add: ran_def restrict_map_def)
pabs_eta [simp]: "(λ x ∈ pdom(f) ∙ f(x)p) = f"
by (simp add: pabs_def, transfer, auto simp add: fun_eq_iff domIff restrict_map_def)
pabs_id [simp]: "(λ x ∈ A | P x ∙ x) = pId_on {x∈A. P x}"
unfolding pabs_def by (transfer, simp add: restrict_map_def)
pfun_entries_pabs: "pfun_entries A f = (λ x ∈ A ∙ f x)"
by (simp add: pabs_def, transfer, auto)
pabs_insert_maplet: "(λ x∈insert y A ∙ f(x)) = (λ x∈A ∙ f(x)) ⊕ {y ↦ f(y)}p"
by (simp add: p: pabs_, tra, aut simpsimp add: restr)
‹ This rule can perhaps be simplified ›
pcomp_pabs:
"(λ x ∈ A | P x ∙ f x) ∘p (λ x ∈ B | Q x ∙ g x)
= (λ x ∈ pdom (pabs B Q g ⊳p (A ∩ Collect P)) ∙ (f (g x)))"
-
have "pabs A P f ∘p pabs B Q g = (λ x ∈ pdom (pabs A P f ∘p pabs B Q g) ∙ (pfun_app (pabs A P f ∘p pabs B Q g)) x)"
java.lang.NullPointerException
also have "... = (λ x ∈ pdom (pabs B Q g ⊳p (A ∩ Collect P)) ∙ (f (g x)))"
unfolding pabs_def
by (transfer, auto simp add: restrict_map_def map_comp_def ran_restrict_map_def fun_eq_iff)
finally show ?thesis .
pabs_rres [simp]: "pabs A P f ⊳p B = pabs A (λ x. P x ∧ f x ∈ B) f"
by (simp add: pabs_def, transfer, auto simp add: ran_restrict_map_def restrict_map_def)
(* This law should be generalised *)
lemma pabs_simple_comp [simp]: "(λ x ∙ f x) ∘p g(k ↦ v)p = ((λ x ∙ f x) ∘p g)(k ↦ f v)p" by (simp add: pabs_def, transfer, auto)
lemma pabs_comp: "(λ x ∈ A ∙ f x) ∘p g = (λ x ∈ pdom (g ⊳p A) ∙ f (pfun_app g x))" by (metis pabs_eta pcomp_pabs pdom_pId_on pdom_pabs)
subsection ‹ Summation › definition pfun_sum :: "('k, 'v::comm_monoid_add) pfun ==> 'v" where
"pfun_sum f = sum (pfun_app f) (pdom f)" lemma pfun_sum_empty [simp]: "pfun_sum {}p = 0" by (simp add: pfun_sum_def)
lemma pfun_sum_upd_1: assumes "finite(pdom(m))" "k ∉ pdom(m)" shows "pfun_sum (m(k ↦ v)java.lang.NullPointerException proof - from assms(2) have"(∑x∈pdom m. if k = x then v else m(x)p) = sum (pfun_app m) (pdom m)" by (auto intro!: sum.cong) thus ?thesis by (simp_all add: pfun_sum_def assms add.commute cong: sum.cong) qed
lemma pfun_sums_upd_2: assumes"finite(pdom(m))" shows"pfun_sum (m(k ↦ v)p) = pfun_sum ((- {k}) ⊲p m) + v" proofcases <> pdom) case True thenshow ?thesis by (simp add: pfun_sum_upd_1 assms) next case False thenshow ?thesis using assms pfun_sum_upd_1[of "((- {k}) ⊲p m)" k v] by (simp add: pfun_sum_upd_1) qed
lemma pfun_sum_dom_res_insert [simp]: assumes"x ∈ pdom f""x ∉ A""finite A" shows"pfun_sum ((insert x A) ⊲p f) = f(x)p + pfun_sum (A ⊲ i!: "<>I"([w β&E(1)]] using assms by (simp add: pfun_sum_def) lemma pfun_sum_pdom_res: fixes f :: "('a,'b::ab_group_add) pfun" assumes "finite(pdom f)" shows "pfun_sum (A ⊲p f) = pfun_sum f - (pfun_sum ((- A) ⊲p f))" proof - have 1:"A ∩ pdom(f) = pdom(f) - (pdom(f) - A)" by (auto) have 2: "sum (pfun_app f) (pdom f) - sum (pfun_app "KBasic:3"THENequiv)
sum (pfun_app f) (pdom f) - sum (pfun_app f) (- A ∩ pdom f)" by (auto simp add: sum_diff Int_commute boolean_algebra_class.diff_eq assms) show ?thesis by (simp add: pfun_sum_def 1 2 sum_diff assms) qed lemma pfun_sum_pdom_antires [simp]: fixes f :: "('a,'b::ab_group_add) pfun" assumes "finite(pdom f)" shows "pfun_sum ((- A) ⊲p f) = pfun_sum f - pfun_sum (A ⊲p f)" using assms by (subst pfun_sum_pdom_res, simp_all add: assms)
subsection ‹ Conversions ›
definition list_pfun :: "'a list ==> nat 🍋 'a" where
"list_pfun xs = (λ i | 0 < i ∧ i ≤ length xs ∙ xs ! (i-1))"
lemma pfun_app_list_pfun: "[0 < i; i ≤ length xs ‹
by (simp add: list_pfun_def)
pfun_graph_list_pfun: "pfun_graph (list_pfun xs) = (λ i. (i, xs ! (i - 1))) ` {1..length xs}"
by (simp add: list_pfun_def pfun_graph_pabs, auto)
range_list_pfun:
"range list_pfun = {f :: nat 🍋 'a. ∃ i. pdom(f) = {1..i}}"
(rule set_eqI, rule iffI)
fix f :: "nat 🍋 'a"
assume "f ∈ range list_pfun"
thus "f ∈ {f. ∃i. pdom f = {1..i}}"
fix f :: "nat 🍋 'a"
assume "f ∈ {f. ∃i. pdom f = {1..i}}"
thus "f ∈ range list_pfun"
proof (unfold list_pfun_def pabs_def image_def, transfer)
fix f :: "nat ==> 'a option"
assume "f ∈ {f. ∃i. dom f = {1..i}}"
then obtain i where i:"dom f = {1..i}"
by blast
hence 1: "∧x. dom f = {Suc 0..i} ==> 0 < x ==> x ≤ i ==> f x = Some (the (f x))"
by (metis Suc_leI atLeastAtMost_iff domIff option.exhaust_sel)
with by (metis G G_ "qml:2"[axiom_inst "\<rightarrowE
using atLeastAtMost_iff not_one_le_zero by blast
from i 1 2 have f: "f = (λxa. Some (map (the ∘ f ∘ nat) [1..int i] ! (xa - Suc 0))) |` {ia. 0 < ia ∧ ia ≤ length (map (the ∘ f ∘ nat) [1..int i])}"
by (auto simp add: fun_eq_iff restrict_map_def)
have 3: "(λxa. Some (map (the ∘ f ∘ nat) [1..int i] ! (xa - Suc 0))) |` {ia. 0 < ia∧ ia ≤ length (map (the ∘ f ∘ nat) [1..int i])} ∈ {y. ∃x∈UNIV.
by (auto simp add: fun_eq_iff restrict_map_def)
show "f ∈ {y. ∃x∈UNIV. y = (λxa. if xa ∈ UNIV then Some (x ! (xa - 1)) else None) |` (UNIV ∩ {i. 0 < i ∧ i ≤ length x})}"
using "3" f by auto
qed
pfun_lens :: "'a ==> ('b ==> ('a, 'b) pfun)" where
lens_defs]: "pfun_lens i = ( lens_get = λ s. s(i)p, lens_put = λ s v. s(i ↦ v)p)"
pfun_lens_mwb [simp]: "mwb_lens (pfun_lens i)"
by (unfold_locales, simp_all add: pfun_lens_def)
pfun_lens_src: "S i = {f. i ∈ pdom(f)}"
by (simp add: lens_defs lens_source_def, transfer, force)
lens_override_pfun_lens:
"E[THEN "∀THEN "∀,
by (simp add: lens_defs pfun_ovrd_single_upd)
‹ Prism Functions ›
‹ We can use prisms to index a type and construct partial functions. ›
prism_fun :: "('a ==>\△ 'e) ==> 'a set ==> ('a ==> bool × 'b) ==> ('e 🍋 'b)"
where [code_unfold]: "prism_fun c A PB = (λ x∈build ` A | fst (PB (the (match x))) ∙ snd (PB (the (match x))))"
prism_fun_upd :: "('e 🍋 'b) ==> ('a ==>\△ 'e) ==> 'a set ==> ('a ==> bool × 'b) ==> ('e
where [code_unfold]: "prism_fun_upd F c A PB = F ⊕ prism_fun c A PB"
"f(c{v ∈ A. P} ==> B)" == "CONST prism_fun_upd f c A (λ v. (P, B))"
"f(c{v ∈ A} ==> B)" == "f(c{v ∈ A. CONST True} ==> B)"
"f(c v ==> B)" == "f(c{v ∈ CONST UNIV} ==> B)"
"_prism_fun_upd m (_prism_Maplets xy ms)" ⇌ "_prism_fun_upd (_prism_fun_upd m xy) ms"
"_prism_fun ms" ⇌ "_prism_fun_upd {}p ms"
"_prism_fun (_prism_Maplets ms1 ms2)" ↽ "_prism_fun_upd (_prism_fun ms1) ms2"
"_prism_Maplets ms1 (_prism_Maplets ms2 ms3)" ↽ "_prism_Maplets (_prism_Maplets ms1 ms2) ms3"
dom_prism_fun: "wb_prism c ==> pdom(prism_fun c A PB) = {build v | v. v ∈
by (simp add: prism_fun_def, auto)
prism_fun_compat: "c ∇ d ==> prism_fun c A PB ## prism_fun d B QB"
by (auto intro!: pfun_indep_compat simp add: prism_fun_def prism_diff_build)
prism_fun_commute: "c ∇ d ==> prism_fun c A PB ⊕ prism_fun d B QB = prism_fun d B QB ⊕ prism_fun c A PB"
by (meson override_comm prism_fun_compat)
prism_fun_apply: "[ wb_prism c; v ∈ A; fst (PB v) ]==> (prism_fun c A PB)(build\box(G]v'&[R']u' →
by (simp add: prism_fun_def)
prism_fun_update_app_1 [simp]: "[ wb_prism c; v ∈ A; P v ]==> (f(c{x ∈ A. P(x)} ==> B(x)))(build v)p = B v"
by (simp add: prism_fun_def prism_fun_upd_def)
prism_fun_update_app_2 [simp]: "[ wb_prism c; wb_prism d; d ∇ c ]==> (f(c{x ∈A. P(x)} ==> B(x)))(build v)p = f(build v)p"
by (simp add: prism_fun_def prism_fun_upd_def image_iff prism_diff_build)
prism_fun_update_cancel [simp]: "f(c{x ∈ A. P(x)} ==> g(x) | c{x ∈ A. P(x)} ==> h(x)) = f(c{x ∈ A. P(x)} ==> h(x))"
by (simp add: prism_fun_def prism_fun_upd_def override_assoc[THEN sym] pfun_override_fully)
prism_fun_update_commute:
"c ∇ d ==> f(c{x ∈ A. P(x)} ==> g(x) | d{y ∈ B. Q(y)} ==> h(y))
= f(d{y ∈ B. Q(y)} ==> h(y) | c{x ∈ A. P(x)} ==> g(x))"
by (simp add: prism_fun_upd_def override_assoc[THEN sym] prism_fun_commute)
case_sum_Plus: "case_sum f g ` (A 🪙; rule raa-c:1"
by (simp add: image_iff Plus_def, metis (no_types, lifting) image_Un image_cong image_image sum.case(1) sum.case(2))
build_in_dom_prism_fun: "[ wb_prism c; x ∈ A; fst (PB x) ]==> build x ∈ pdom (prism_fun c A PB)"
by (auto simp add: dom_prism_fun)
prism_diff_implies_indep_funs:
"[ wb_prism c; wb_prism d; c ∇ d ]==> pdom(prism_fun c A Pσ) ∩ pdom(prism_fun d B Qρ) = {}"
by (auto simp add: dom_prism_fun prism_diff_build)
prism_fun_cong: "[ c = d; A = B; PB = QB ]==> prism_fun c A PB = prism_fun d B QB"
by blast
prism_fun_cong2:
assumes
"wb_prism c1" "wb_prism c2"
"c1 = c2" "A1 = A2"
"∧ i. i ∈ AAOT_assume ‹¬◻([G]v' & [R']uv' → v' =E a)›
"∧ i. [ i ∈ A1; P1 i ]==> B1 i = B2 i"
shows "prism_fun c1 A1 (λ x. (P1 x, B1 x)) = prism_fun c2 A2 (λ y. (P2 y, B2 y))"
using assms
by (auto intro!: pabs_cong simp add: prism_fun_def)
map_pfun_prism_fun [simp]: "map_pfun f (prism_fun a A (λ x. (B x, C x))) = prism_fun a A (λ x. (B x, f (C x)))"
by (simp add: prism_fun_def)
prism_fun_as_map:
"wb_prism b ==>
prism_fun b A PB = pfun_of_map (λ x. case match x of None ==> None | Some x ==> if x ∈ A ∧ fst (PB x) then Some (snd (PB x)) else None)"
by (simp add: prism_fun_def pfun_eq_iff domIff pdom.abs_eq option.case_eq_if, safe, simp_all)
(metis (no_types, lifting) image_iff option.collapse option.distinct(1) wb_prism.build_match, metis option.discI)
‹ Code Generator ›
‹ Associative Lists ›
relt_pfun_iff:
"relt_pfun R f g ⟷ (pdom(f) = pdom(g) ∧ (∀ x∈pdom(f). R (f(x)p) (g(x)p)))"
by (, autosim add: rel_map_iff)
pfun_of_alist :: "('a × 'b) list ==> 'a 🍋 'b" is map_of .
map_graph_map_of: "map_graph (map_of xs) = set (AList.clearjunk xs)"
by (metis graph_def graph_map_of map_graph_def)
pfun_graph_alist [code]: "pfun_graph (pfun_of_alist xs) = set (AList.clearjunk xs)"
by (transfer, meson map_graph_map_of)
empty_pfun_alist [code]: "{}p = pfun_of_alist []"
by (transfer, simp)
update_pfun_alist [code]: "pfun_upd (pfun_of_alist xs) k v = pfun_of_alist (AList.update k v xs)"
by transfer (simp add: update_conv')
apply_pfun_alist [code]:
"pfun_app (pfun_of_alist xs) k = (if k ∈ set (map fst xs) then the (map_of xs k) else undefined)"
apply (transfer, simp, safe)
apply (metis map_of_eq_None_iff option.distinct(1))
apply (metis eq_fst_iff weak_map_of_SomeI)
done
map_of_Cons_code [code]:
"pfun_lookup (pfun_of_alist []) k = None"
"pfun_lookup (pfun_of_alist ((l, v) # ps)) k = (if l = k then Some v else map_of ps k)"
by (transfer, simp)+
map_pfun_alist [code]:
"map_pfun f (pfun_of_alist m) = pfun_of_alist (map (λ (k, v). (k, f v)) m)"
by (transfer, simp add: map_of_map)
map_pfun_of_map [code]: "map_pfun f (pfun_of_map g) = pfun_of_map (λ x. map_option f (g x))"
by (auto simp add: map_pfun_def pfun_of_map_inject fun_eq_iff)
pdom_res_alist [code]:
"A ⊲p (pfun_of_alist m) = pfun_of_alist (AList.restrict A m)"
by (transfer, simp add: restr_conv')
pran_res_alist_distinct:
"distinct (map fst xs) ==> pfun_of_alist xs ⊳p A = pfun_of_alist (filter (λ(k, v). v ∈ A) xs)"
by (induct xs, auto)
pran_res_alist [code]: "pfun_of_alist xs ⊳p A = pfun_of_alist (filter (λ(k, v). v ∈ A) (AList.clearjunk xs))"
by (metis distinct_clearjunk pfun_of_alist_clearjunk pran_res_alist_distinct)
pdom_res_set_map [code]:
"set xs ⊲p (pfun_of_map m) = pfun_of_alist (map (λ x. (x, the (m x))) (filter (λ x. m x ≠ None) xs))"
(induct xs)
case Nil
then show ?case by auto
case (Cons a xs)
then show ?case
by (simp, safe; transfer)
(simp add: restrict_map_insert, metis Int_insert_right_if0 Map.restrict_restrict domIff map_restrict_dom)
plus_pfun_alist [code]: "pfun_of_alist f ⊕ pfun_of_alist g = pfun_of_alist (g @ f)"
by (transfer, simp)
pfun_entries_alist [code]: "pfun_entries (set ks) f = pfun_of_alist (map (λ k. (k, f k)) ks)"
by (auto simp add: pfun_eq_iff apply_pfun_alist map_of_map prod.case_eq_if image_iff map_of_map_restrict)
pdom_res_entries_alist [code]:
"A ⊲p pfun_entries (set bs) f =
pfun_of_alist (map (λ k. (k, f k)) (filter (λx. x ∈ A) bs))"
by (metis inter_set_filter pdom_res_entries pfun_entries_alist)
pfun_alist_oplus_map [code]:
"pfun_of_alist xs ⊕ pfun_of_map f = pfun_of_map (λ k. case f k of None ==> map_of xs k | Some v ==> Some v)"
by (simp add: map_add_def oplus_pfun.abs_eq pfun_of_alist.abs_eq)
pfun_map_oplus_alist [code]:
"pfun_of_map f ⊕ pfun_of_alist xs = pfun_of_map (λ k. if k ∈ set (map fst xs) then map_of xs k else f k)"
by (simp add: map_add_def oplus_pfun.abs_eq pfun_of_alist.abs_eq)
(metis map_of_eq_None_iff option.case_eq_if option.exhaust option.sel)
pfun_singleton_alist [code]: "pfun_singleton (pfun_of_alist [(k, v)]) = True"
by simp
equal_pfun [code]:
"HOL.equal (pfun_of_alist xs) (pfun_of_alist ys) ⟷
(let ks = map fst xs; ls = map fst ys
in (∀l∈set ls. l ∈ set ks) ∧ (∀k∈set ks. k ∈ set ls ∧ map_of xs k = map_of ys k))"
apply (simp add: equal_pfun_def, transfer, safe, simp_all)
apply (metis map_of_eq_None_iff option.distinct(1) weak_map_of_SomeI)
apply (metis domI domIff map_of_eq_None_iff weak_map_of_SomeI)
apply (metis (no_types, lifting) image_iff map_of_eq_None_iff)
done
set_inter_Collect: "set xs ∩ Collect P = set (filter P xs)"
by (auto)
‹ Partial abstractions can either be modelled finitely, as lists, or infinitely as total functions.
over finite set, then
it is compiled to an associative list. Otherwise, it becomes an enriched total function via
@{const pfun_entries}. ›
pabs_set [code]: "pabs (set xs) P f = pfun_of_alist (map (λk. (k, f k)) (filter P xs))"
by (auto simp add: pfun_eq_iff apply_pfun_alist map_of_map prod.case_eq_if image_iff map_of_map_restrict)
pabs_coset [code]:
"pabs (List.coset A) P f = pfun_of_map (λ x. if x ∈ List.coset A ∧ P x then Some (f x) else None)"
by (simp add: pabs_def, transfer, auto)
pfun_app_of_map [code]: "pfun_app (pfun_of_map f) x = the (f x)"
by (simp add: domIff option.the_def)
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.