Merge branch 'afp_resubmission' of https://git.logicalhacking.com/Isabelle_DOF/Isabelle_DOF into afp_resubmission

This commit is contained in:
Burkhart Wolff 2024-04-16 11:11:07 +02:00
commit 7d6048bf64
2 changed files with 89 additions and 80 deletions

View File

@ -36,9 +36,12 @@ theory Isa_DOF (* Isabelle Document Ontology Framework *)
and "open_monitor*" "close_monitor*"
"declare_reference*" "update_instance*"
"doc_class" "onto_class" (* a syntactic alternative *)
"ML*"
"doc_class" "onto_class" (* a syntactic alternative *)
"onto_morphism" :: thy_decl
and "to"
and "ML*"
"define_shortcut*" "define_macro*" :: thy_decl
and "definition*" :: thy_defn
and "theorem*" "lemma*" "corollary*" "proposition*" :: thy_goal_stmt
and "schematic_goal*" :: thy_goal_stmt
@ -3211,6 +3214,76 @@ val _ =
val clean_mixfix_sub = translate_string
(fn "\<^sub>_" => "_"
| "\<^sub>'" => "'"
| c => c);
val prefix_sub = prefix "\<^sub>"
val convertN = "convert"
fun add_onto_morphism classes_mappings eqs thy =
if (length classes_mappings = length eqs) then
let
val specs = map (fn x => (Binding.empty_atts, x)) eqs
val converts =
map (fn (oclasses, dclass) =>
let
val oclasses_string = map YXML.content_of oclasses
val dclass_string = YXML.content_of dclass
val const_sub_name = dclass_string
|> (oclasses_string |> fold_rev (fn x => fn y => x ^ "_" ^ y))
|> String.explode |> map (fn x => "\<^sub>" ^ (String.str x)) |> String.concat
val convert_typ = oclasses_string |> rev |> hd
|> (oclasses_string |> rev |> tl |> fold (fn x => fn y => x ^ " \<times> " ^ y))
val convert_typ' = convert_typ ^ " \<Rightarrow> " ^ dclass_string
val oclasses_sub_string = oclasses_string
|> map (clean_mixfix_sub
#> String.explode
#> map (prefix_sub o String.str)
#> String.concat)
val mixfix = oclasses_sub_string |> rev |> hd
|> (oclasses_sub_string |> rev |> tl |> fold (fn x => fn y => x ^ "\<^sub>\<times>" ^ y))
|> ISA_core.clean_mixfix
val mixfix' = convertN ^ mixfix ^ "\<^sub>\<Rightarrow>"
^ (dclass_string |> clean_mixfix_sub |> String.explode
|> map (prefix_sub o String.str) |> String.concat)
in SOME (Binding.name (convertN ^ const_sub_name), SOME convert_typ', Mixfix.mixfix mixfix') end)
classes_mappings
val args = map (fn (x, y) => (x, y, [], [])) (converts ~~ specs)
val lthy = Named_Target.theory_init thy
val updated_lthy = fold (fn (decl, spec, prems, params) => fn lthy =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args lthy
in Local_Theory.exit_global updated_lthy end
(* alternative way to update the theory using the Theory.join_theory function *)
(*val lthys = map (fn (decl, spec, prems, params) =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args
val thys = map (Local_Theory.exit_global) lthys
in Theory.join_theory thys end*)
else error("The number of morphisms declarations does not match the number of definitions")
fun add_onto_morphism' (classes_mappings, eqs) = add_onto_morphism classes_mappings eqs
val parse_onto_morphism = Parse.and_list
((Parse.$$$ "(" |-- Parse.enum1 "," Parse.typ --| Parse.$$$ ")" --| \<^keyword>\<open>to\<close>)
-- Parse.typ)
-- (\<^keyword>\<open>where\<close> |-- Parse.and_list Parse.prop)
(* The name of the definitions must follow this rule:
for the declaration "onto_morphism (AA, BB) to CC",
the name of the constant must be "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<Rightarrow>\<^sub>C\<^sub>C". *)
val _ =
Outer_Syntax.command \<^command_keyword>\<open>onto_morphism\<close> "define ontology morpism"
(parse_onto_morphism >> (Toplevel.theory o add_onto_morphism'));
end (* struct *)
\<close>

View File

@ -16,8 +16,6 @@ theory
"M_05_Proofs_Ontologies"
imports
"M_04_Document_Ontology"
keywords "onto_morphism" :: thy_decl
and "to"
begin
(*>*)
@ -42,69 +40,6 @@ section*["morphisms"::scholarly_paper.text_section] \<open>Proving Properties ov
subsection\<open>Ontology-Morphisms: a Prototypical Example\<close>
(*<*) (* THIS CODE SHOULD GO INTO THE DOF KERNEL \<And>! *)
ML\<open>
fun add_onto_morphism classes_mappings eqs thy =
if (length classes_mappings = length eqs) then
let
val specs = map (fn x => (Binding.empty_atts, x)) eqs
val converts =
map (fn (oclasses, dclass) =>
let
val oclasses_string = map YXML.content_of oclasses
val dclass_string = YXML.content_of dclass
val const_sub_name = dclass_string
|> (oclasses_string |> fold_rev (fn x => fn y => x ^ "_" ^ y))
|> String.explode |> map (fn x => "\<^sub>" ^ (String.str x)) |> String.concat
val convert_typ = oclasses_string |> rev |> hd
|> (oclasses_string |> rev |> tl |> fold (fn x => fn y => x ^ " \<times> " ^ y))
val convert_typ' = convert_typ ^ " \<Rightarrow> " ^ dclass_string
val oclasses_sub_string = oclasses_string
|> map (fn x => x |> String.explode |> map (fn y => "\<^sub>" ^ (String.str y)) |> String.concat)
val mixfix = oclasses_sub_string |> rev |> hd
|> (oclasses_sub_string |> rev |> tl |> fold (fn x => fn y => x ^ "\<^sub>\<times>" ^ y))
val mixfix' = "convert" ^ mixfix ^ "\<^sub>\<Rightarrow>"
^ (dclass_string |> String.explode
|> map (fn x => "\<^sub>" ^ (String.str x)) |> String.concat)
in SOME (Binding.name ("convert" ^ const_sub_name), SOME convert_typ', Mixfix.mixfix mixfix') end)
classes_mappings
val args = map (fn (x, y) => (x, y, [], [])) (converts ~~ specs)
val lthy = Named_Target.theory_init thy
val updated_lthy = fold (fn (decl, spec, prems, params) => fn lthy =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args lthy
in Local_Theory.exit_global updated_lthy end
(* alternative way to update the theory using the Theory.join_theory function *)
(*val lthys = map (fn (decl, spec, prems, params) =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args
val thys = map (Local_Theory.exit_global) lthys
in Theory.join_theory thys end*)
else error("The number of morphisms declarations does not match the number of definitions")
fun add_onto_morphism' (classes_mappings, eqs) = add_onto_morphism classes_mappings eqs
val parse_onto_morphism = Parse.and_list
((Parse.$$$ "(" |-- Parse.enum1 "," Parse.typ --| Parse.$$$ ")" --| \<^keyword>\<open>to\<close>)
-- Parse.typ)
-- (\<^keyword>\<open>where\<close> |-- Parse.and_list Parse.prop)
(* The name of the definitions must follow this rule:
for the declaration "onto_morphism (AA, BB) to CC",
the name of the constant must be "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<Rightarrow>\<^sub>C\<^sub>C".
See the examples below.
*)
val _ =
Outer_Syntax.command \<^command_keyword>\<open>onto_morphism\<close> "define ontology morpism"
(parse_onto_morphism >> (Toplevel.theory o add_onto_morphism'));
\<close>
(*>*)
text\<open>We define a small ontology with the following classes:\<close>
doc_class AA = aa :: nat
@ -126,21 +61,23 @@ resulting transformation of @{doc_class AA}-instances and @{doc_class BB}-instan
but not injective. The \<^term>\<open>CC.tag_attribute\<close> is used to potentially differentiate instances with
equal attribute-content and is irrelevant here.\<close>
text\<open>This specification construct introduces the following constants and definitions:
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C :: AA \<times> BB \<Rightarrow> CC\<close>}
\<^item> @{term [source] \<open>convert\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: DD \<times> EE \<Rightarrow> FF\<close>}
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C\<^sub>_\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: AA \<times> BB \<times> CC \<times> DD \<times> EE \<Rightarrow> FF\<close>}
and corresponding definitions. \<close>
(*<*) (* Just a test, irrelevant for the document.*)
onto_morphism (AA, BB, CC, DD, EE) to FF
where "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<times>\<^sub>C\<^sub>C\<^sub>\<times>\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F \<sigma> = \<lparr> FF.tag_attribute = 1::int,
doc_class A_A = aa :: nat
doc_class BB' = bb :: int
onto_morphism (A_A, BB', CC, DD, EE) to FF
where "convert\<^sub>A\<^sub>_\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>'\<^sub>\<times>\<^sub>C\<^sub>C\<^sub>\<times>\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F \<sigma> = \<lparr> FF.tag_attribute = 1::int,
FF.ff = int(aa (fst \<sigma>)) + bb (fst (snd \<sigma>))\<rparr>"
(*>*)
text\<open>This specification construct introduces the following constants and definitions:
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C :: AA \<times> BB \<Rightarrow> CC\<close>}
\<^item> @{term [source] \<open>convert\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: DD \<times> EE \<Rightarrow> FF\<close>}
% @{term [source] \<open>convert\<^sub>A\<^sub>_\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>'\<^sub>\<times>\<^sub>C\<^sub>C\<^sub>\<times>\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F :: A_A \<times> BB' \<times> CC \<times> DD \<times> EE \<Rightarrow> FF\<close>}
and corresponding definitions. \<close>
subsection\<open>Proving the Preservation of Ontological Mappings : A Document-Ontology Morphism\<close>
text\<open>\<^dof> as a system is currently particularly geared towards \<^emph>\<open>document\<close>-ontologies, in
@ -244,7 +181,6 @@ next
using concatWith.elims apply blast
using list.set_cases by force
qed
onto_morphism (acm) to elsevier
where "convert\<^sub>a\<^sub>c\<^sub>m\<^sub>\<Rightarrow>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r \<sigma> =
@ -384,7 +320,7 @@ text\<open>These two example ontologies were linked via conversion functions cal
The hic is that we can prove for the morphisms connecting these ontologies, that the conversions
are guaranteed to preserve the data-invariants, although the data-structures (and, of course,
the presentation of them) is very different. Besides, morphisms functions can be ``forgetful''
(\<^ie> surjective), ``embedding'' (\<^ie> injective) or even ``one-to-one'' ((\<^ie> bikjective).\<close>
(\<^ie> surjective), ``embedding'' (\<^ie> injective) or even ``one-to-one'' ((\<^ie> bijective).\<close>
definition Item_to_Resource_morphism :: "Item \<Rightarrow> Resource"
("_ \<langle>Resource\<rangle>\<^sub>I\<^sub>t\<^sub>e\<^sub>m" [1000]999)
@ -483,7 +419,7 @@ Recall that the monitor of \<^term>\<open>scholarly_paper.article\<close> is def
\<^vs>\<open>0.5cm\<close> However, it is possible to reason over the language of monitors and prove classical
refinement notions such as trace-refinement on the monitor-level, so once-and-for-all for all
instances of validated documents conforming to a particular ontology. The primitive recursive
operators\<^term>\<open>RegExpInterface.Lang\<close> and \<^term>\<open>RegExpInterface.L\<^sub>s\<^sub>u\<^sub>b\<close> generate the languages of the
operators \<^term>\<open>RegExpInterface.Lang\<close> and \<^term>\<open>RegExpInterface.L\<^sub>s\<^sub>u\<^sub>b\<close> generate the languages of the
regular expression language, where \<^term>\<open>L\<^sub>s\<^sub>u\<^sub>b\<close> takes the sub-ordering relation of classes into
account.
@ -510,7 +446,7 @@ of the above language refinement is quasi automatic. This proof is also part of
(*<*)
(* switch on regexp syntax *)
(* switch off regexp syntax *)
no_notation Star ("\<lbrace>(_)\<rbrace>\<^sup>*" [0]100)
no_notation Plus (infixr "||" 55)
no_notation Times (infixr "~~" 60)