βΉ 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. βΊ
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_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)"
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)
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)
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)
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_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
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_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
βΉ 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.