theory ClassType
  imports
    Main
    "Ecore-GROOVE-Mapping.Type_Model_Graph_Mapping"
    "Ecore-GROOVE-Mapping.Identifier_List"
begin

section "Definition of a type model which introduces a Class"

definition tmod_class :: "'t Id \<Rightarrow> 't type_model" where
  "tmod_class name = \<lparr>
    Class = {name},
    Enum = {},
    UserDataType = {},
    Field = {},
    FieldSig = (\<lambda>x. undefined),
    EnumValue = {},
    Inh = {},
    Prop = {},
    Constant = {},
    ConstType = (\<lambda>x. undefined)
  \<rparr>"

lemma tmod_class_correct: "type_model (tmod_class name)"
proof (intro type_model.intro)
  have "asym {} \<and> irrefl {}"
    by (simp add: asym.intros irrefl_def)
  then show "asym (Inh (tmod_class name)) \<and> irrefl ((Inh (tmod_class name))\<^sup>+)"
    unfolding tmod_class_def
    by simp
qed (simp_all add: tmod_class_def)

lemma tmod_class_combine_correct:
  assumes "type_model Tmod"
  assumes new_class: "name \<notin> Class Tmod \<union> Enum Tmod \<union> UserDataType Tmod"
  assumes "\<And>x. x \<in> Class Tmod \<union> Enum Tmod \<union> UserDataType Tmod \<Longrightarrow> \<not>id_in_ns name (Identifier x) \<and> \<not>id_in_ns x (Identifier name)"
  shows "type_model (tmod_combine Tmod (tmod_class name))"
proof (intro tmod_combine_full_distinct_correct)
  show "type_model (tmod_class name)"
    by (fact tmod_class_correct)
next
  show "(Class Tmod \<union> Enum Tmod \<union> UserDataType Tmod) \<inter> (Class (tmod_class name) \<union> Enum (tmod_class name) \<union> UserDataType (tmod_class name)) = {}"
    unfolding tmod_class_def
    using new_class
    by simp
qed (simp_all add: assms tmod_class_def)

section "Encoding of a Class as Node Type in GROOVE"

definition tg_class_as_node_type :: "'t Id \<Rightarrow> ('t list) type_graph" where
  "tg_class_as_node_type name = \<lparr>
    NT = {type (id_to_list name)},
    ET = {},
    inh = {(type (id_to_list name), type (id_to_list name))},
    abs = {},
    mult = (\<lambda>x. undefined),
    contains = {}
  \<rparr>"

lemma tg_class_as_node_type_correct: "type_graph (tg_class_as_node_type name)"
proof (intro type_graph.intro)
  fix n
  assume "n \<in> NT (tg_class_as_node_type name)"
  then have "n = type (id_to_list name)"
    unfolding tg_class_as_node_type_def
    by simp
  then have "n \<in> Lab\<^sub>t"
    by (simp add: Lab\<^sub>t.rule_type_labels)
  then show "n \<in> Lab\<^sub>t \<union> Lab\<^sub>p"
    by blast
next
  show "Partial_order (inh (tg_class_as_node_type name))"
    unfolding tg_class_as_node_type_def partial_order_on_def preorder_on_def
    by simp
qed (simp_all add: tg_class_as_node_type_def)

lemma tg_class_as_node_type_combine_correct:
  assumes "type_graph TG"
  assumes new_node_type: "type (id_to_list name) \<notin> NT TG"
  shows "type_graph (tg_combine TG (tg_class_as_node_type name))"
proof (intro tg_combine_distinct_correct)
  show "type_graph (tg_class_as_node_type name)"
    by (fact tg_class_as_node_type_correct)
qed (simp_all add: tg_class_as_node_type_def assms)

subsection "Transformation functions"

definition tmod_class_to_tg_class_as_node_type :: "'t type_model \<Rightarrow> ('t list) type_graph" where
  "tmod_class_to_tg_class_as_node_type Tmod = \<lparr>
    NT = type ` id_to_list ` Class Tmod,
    ET = {},
    inh = type ` id_to_list ` Class Tmod \<times> type ` id_to_list ` Class Tmod,
    abs = {},
    mult = (\<lambda>x. undefined),
    contains = {}
  \<rparr>"

lemma tmod_class_to_tg_class_as_node_type_proj:
  shows "tmod_class_to_tg_class_as_node_type (tmod_class name) = tg_class_as_node_type name"
  unfolding tmod_class_to_tg_class_as_node_type_def tmod_class_def tg_class_as_node_type_def
  by simp

lemma tmod_class_to_tg_class_as_node_type_func:
  shows "tg_combine_mapping_function (tmod_class_to_tg_class_as_node_type) (tmod_class name) (tg_class_as_node_type name)"
  by (intro tg_combine_mapping_function.intro)
    (simp_all add: tmod_class_to_tg_class_as_node_type_def tmod_class_def tg_class_as_node_type_def tmod_combine_def)

definition tg_class_as_node_type_to_tmod_class :: "('t list) type_graph \<Rightarrow> 't type_model" where
  "tg_class_as_node_type_to_tmod_class TG = \<lparr>
    Class = list_to_id ` unlabel ` NT TG,
    Enum = {},
    UserDataType = {},
    Field = {},
    FieldSig = (\<lambda>x. undefined),
    EnumValue = {},
    Inh = {},
    Prop = {},
    Constant = {},
    ConstType = (\<lambda>x. undefined)
  \<rparr>"

lemma tg_class_as_node_type_to_tmod_class_proj:
  shows "tg_class_as_node_type_to_tmod_class (tg_class_as_node_type name) = tmod_class name"
  unfolding tg_class_as_node_type_to_tmod_class_def tmod_class_def tg_class_as_node_type_def
  by (simp add: id_to_list_inverse)

lemma tg_class_as_node_type_to_tmod_class_func:
  shows "tmod_combine_mapping_function (tg_class_as_node_type_to_tmod_class) (tg_class_as_node_type name) (tmod_class name)"
  by (intro tmod_combine_mapping_function.intro)
    (simp_all add: tg_class_as_node_type_to_tmod_class_def tmod_class_def tg_class_as_node_type_def tg_combine_def id_to_list_inverse)

end


(*  Title:      Messages.thy
    Author:     Andreas Viktor Hess, DTU
    SPDX-License-Identifier: BSD-3-Clause
*)

section \<open>Protocol Messages as (First-Order) Terms\<close>

theory Messages
  imports Miscellaneous "First_Order_Terms.Term"
begin

subsection \<open>Term-related definitions: subterms and free variables\<close>
abbreviation "the_Fun \<equiv> un_Fun1"
lemmas the_Fun_def = un_Fun1_def

fun subterms::"('a,'b) term \<Rightarrow> ('a,'b) terms" where
  "subterms (Var x) = {Var x}"
| "subterms (Fun f T) = {Fun f T} \<union> (\<Union>t \<in> set T. subterms t)"

abbreviation subtermeq (infix "\<sqsubseteq>" 50) where "t' \<sqsubseteq> t \<equiv> (t' \<in> subterms t)"
abbreviation subterm (infix "\<sqsubset>" 50) where "t' \<sqsubset> t \<equiv> (t' \<sqsubseteq> t \<and> t' \<noteq> t)"

abbreviation "subterms\<^sub>s\<^sub>e\<^sub>t M \<equiv> \<Union>(subterms ` M)"
abbreviation subtermeqset (infix "\<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t" 50) where "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<equiv> (t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M)"

abbreviation fv where "fv \<equiv> vars_term"
lemmas fv_simps = term.simps(17,18)

fun fv\<^sub>s\<^sub>e\<^sub>t where "fv\<^sub>s\<^sub>e\<^sub>t M = \<Union>(fv ` M)"

abbreviation fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r where "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r p \<equiv> case p of (t,t') \<Rightarrow> fv t \<union> fv t'"

fun fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s where "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` set F)"

abbreviation ground where "ground M \<equiv> fv\<^sub>s\<^sub>e\<^sub>t M = {}"

subsection \<open>Variants that return lists insteads of sets\<close>
fun fv_list where
  "fv_list (Var x) = [x]"
| "fv_list (Fun f T) = concat (map fv_list T)"

definition fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s where
  "fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<equiv> concat (map (\<lambda>(t,t'). fv_list t@fv_list t') F)"

fun subterms_list::"('a,'b) term \<Rightarrow> ('a,'b) term list" where
  "subterms_list (Var x) = [Var x]"
| "subterms_list (Fun f T) = remdups (Fun f T#concat (map subterms_list T))"

lemma fv_list_is_fv: "fv t = set (fv_list t)"
by (induct t) auto

lemma fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = set (fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"
by (induct F) (auto simp add: fv_list_is_fv fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_def)

lemma subterms_list_is_subterms: "subterms t = set (subterms_list t)"
by (induct t) auto

subsection \<open>The subterm relation defined as a function\<close>
fun subterm_of where
  "subterm_of t (Var y) = (t = Var y)"
| "subterm_of t (Fun f T) = (t = Fun f T \<or> list_ex (subterm_of t) T)"

lemma subterm_of_iff_subtermeq[code_unfold]: "t \<sqsubseteq> t' = subterm_of t t'"
proof (induction t')
  case (Fun f T) thus ?case
  proof (cases "t = Fun f T")
    case False thus ?thesis
      using Fun.IH subterm_of.simps(2)[of t f T]
      unfolding list_ex_iff by fastforce
  qed simp
qed simp

lemma subterm_of_ex_set_iff_subtermeqset[code_unfold]: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M = (\<exists>t' \<in> M. subterm_of t t')"
using subterm_of_iff_subtermeq by blast

subsection \<open>The subterm relation is a partial order on terms\<close>
interpretation "term": order "(\<sqsubseteq>)" "(\<sqsubset>)"
proof
  show "s \<sqsubseteq> s" for s :: "('a,'b) term"
    by (induct s rule: subterms.induct) auto

  show trans: "s \<sqsubseteq> t \<Longrightarrow> t \<sqsubseteq> u \<Longrightarrow> s \<sqsubseteq> u" for s t u :: "('a,'b) term"
    by (induct u rule: subterms.induct) auto

  show "s \<sqsubseteq> t \<Longrightarrow> t \<sqsubseteq> s \<Longrightarrow> s = t" for s t :: "('a,'b) term"
  proof (induction s arbitrary: t rule: subterms.induct[case_names Var Fun])
    case (Fun f T)
    { assume 0: "t \<noteq> Fun f T"
      then obtain u::"('a,'b) term" where u: "u \<in> set T" "t \<sqsubseteq> u" using Fun.prems(2) by auto
      hence 1: "Fun f T \<sqsubseteq> u" using trans[OF Fun.prems(1)] by simp

      have 2: "u \<sqsubseteq> Fun f T"
        by (cases u) (use u(1) in force, use u(1) subterms.simps(2)[of f T] in fastforce)
      hence 3: "u = Fun f T" using Fun.IH[OF u(1) _ 1] by simp

      have "u \<sqsubseteq> t" using trans[OF 2 Fun.prems(1)] by simp
      hence 4: "u = t" using Fun.IH[OF u(1) _ u(2)] by simp

      have "t = Fun f T" using 3 4 by simp
      hence False using 0 by simp
    }
    thus ?case by auto
  qed simp
  thus "(s \<sqsubset> t) = (s \<sqsubseteq> t \<and> \<not>(t \<sqsubseteq> s))" for s t :: "('a,'b) term"
    by blast
qed

subsection \<open>Lemmata concerning subterms and free variables\<close>
lemma fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append: "fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) = fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F@fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G"
by (simp add: fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_def)

lemma distinct_fv_list_idx_fv_disjoint:
  assumes t: "distinct (fv_list t)" "Fun f T \<sqsubseteq> t"
    and ij: "i < length T" "j < length T" "i < j"
  shows "fv (T ! i) \<inter> fv (T ! j) = {}"
using t
proof (induction t rule: fv_list.induct)
  case (2 g S)
  have "distinct (fv_list s)" when s: "s \<in> set S" for s
    by (metis (no_types, lifting) s "2.prems"(1) concat_append distinct_append
          map_append split_list fv_list.simps(2) concat.simps(2) list.simps(9))
  hence IH: "fv (T ! i) \<inter> fv (T ! j) = {}"
    when s: "s \<in> set S" "Fun f T \<sqsubseteq> s" for s
    using "2.IH" s by blast

  show ?case
  proof (cases "Fun f T = Fun g S")
    case True
    define U where "U \<equiv> map fv_list T"

    have a: "distinct (concat U)"
      using "2.prems"(1) True unfolding U_def by auto

    have b: "i < length U" "j < length U"
      using ij(1,2) unfolding U_def by simp_all

    show ?thesis
      using b distinct_concat_idx_disjoint[OF a b ij(3)]
            fv_list_is_fv[of "T ! i"] fv_list_is_fv[of "T ! j"]
      unfolding U_def by force
  qed (use IH "2.prems"(2) in auto)
qed force

lemma distinct_fv_list_Fun_param:
  assumes f: "distinct (fv_list (Fun f ts))"
    and t: "t \<in> set ts"
  shows "distinct (fv_list t)"
proof -
  obtain pre suf where "ts = pre@t#suf" using t by (meson split_list)
  thus ?thesis using distinct_append f by simp
qed

lemmas subtermeqI'[intro] = term.eq_refl

lemma finite_fv_set[intro]: "finite M \<Longrightarrow> finite (fv\<^sub>s\<^sub>e\<^sub>t M)"
by auto

lemma finite_fun_symbols[simp]: "finite (funs_term t)"
by (induct t) simp_all

lemma fv_set_mono: "M \<subseteq> N \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t N"
by auto

lemma subterms\<^sub>s\<^sub>e\<^sub>t_mono: "M \<subseteq> N \<Longrightarrow> subterms\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t N"
by auto

lemma ground_empty[simp]: "ground {}"
by simp

lemma ground_subset: "M \<subseteq> N \<Longrightarrow> ground N \<Longrightarrow> ground M"
by auto

lemma fv_map_fv_set: "\<Union>(set (map fv L)) = fv\<^sub>s\<^sub>e\<^sub>t (set L)"
by (induct L) auto

lemma fv\<^sub>s\<^sub>e\<^sub>t_union: "fv\<^sub>s\<^sub>e\<^sub>t (M \<union> N) = fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv\<^sub>s\<^sub>e\<^sub>t N"
by auto

lemma finite_subset_Union:
  fixes A::"'a set" and f::"'a \<Rightarrow> 'b set"
  assumes "finite (\<Union>a \<in> A. f a)"
  shows "\<exists>B. finite B \<and> B \<subseteq> A \<and> (\<Union>b \<in> B. f b) = (\<Union>a \<in> A. f a)"
by (metis assms eq_iff finite_subset_image finite_UnionD)

lemma inv_set_fv: "finite M \<Longrightarrow> \<Union>(set (map fv (inv set M))) = fv\<^sub>s\<^sub>e\<^sub>t M"
using fv_map_fv_set[of "inv set M"] inv_set_fset by auto

lemma ground_subterm: "fv t = {} \<Longrightarrow> t' \<sqsubseteq> t \<Longrightarrow> fv t' = {}" by (induct t) auto

lemma empty_fv_not_var: "fv t = {} \<Longrightarrow> t \<noteq> Var x" by auto

lemma empty_fv_exists_fun: "fv t = {} \<Longrightarrow> \<exists>f X. t = Fun f X" by (cases t) auto

lemma vars_iff_subtermeq: "x \<in> fv t \<longleftrightarrow> Var x \<sqsubseteq> t" by (induct t) auto

lemma vars_iff_subtermeq_set: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<longleftrightarrow> Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
using vars_iff_subtermeq[of x] by auto

lemma vars_if_subtermeq_set: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>e\<^sub>t M"
by (metis vars_iff_subtermeq_set)

lemma subtermeq_set_if_vars: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
by (metis vars_iff_subtermeq_set)

lemma vars_iff_subterm_or_eq: "x \<in> fv t \<longleftrightarrow> Var x \<sqsubset> t \<or> Var x = t"
by (induct t) (auto simp add: vars_iff_subtermeq)

lemma var_is_subterm: "x \<in> fv t \<Longrightarrow> Var x \<in> subterms t"
by (simp add: vars_iff_subtermeq)

lemma subterm_is_var: "Var x \<in> subterms t \<Longrightarrow> x \<in> fv t"
by (simp add: vars_iff_subtermeq)

lemma no_var_subterm: "\<not>t \<sqsubset> Var v" by auto

lemma fun_if_subterm: "t \<sqsubset> u \<Longrightarrow> \<exists>f X. u = Fun f X" by (induct u) simp_all

lemma subtermeq_vars_subset: "M \<sqsubseteq> N \<Longrightarrow> fv M \<subseteq> fv N" by (induct N) auto

lemma fv_subterms[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms t) = fv t"
by (induct t) auto

lemma fv_subterms_set[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M) = fv\<^sub>s\<^sub>e\<^sub>t M"
using subtermeq_vars_subset by auto

lemma fv_subset: "t \<in> M \<Longrightarrow> fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
by auto

lemma fv_subset_subterms: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
using fv_subset fv_subterms_set by metis

lemma subterms_finite[simp]: "finite (subterms t)" by (induction rule: subterms.induct) auto

lemma subterms_union_finite: "finite M \<Longrightarrow> finite (\<Union>t \<in> M. subterms t)"
by (induction rule: subterms.induct) auto

lemma subterms_subset: "t' \<sqsubseteq> t \<Longrightarrow> subterms t' \<subseteq> subterms t"
by (induction rule: subterms.induct) auto

lemma subterms_subset_set: "M \<subseteq> subterms t \<Longrightarrow> subterms\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subterms t"
by (metis SUP_least contra_subsetD subterms_subset)

lemma subset_subterms_Union[simp]: "M \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M" by auto

lemma in_subterms_Union: "t \<in> M \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M" using subset_subterms_Union by blast

lemma in_subterms_subset_Union: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> subterms t \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M"
using subterms_subset by auto

lemma subterm_param_split:
  assumes "t \<sqsubset> Fun f X"
  shows "\<exists>pre x suf. t \<sqsubseteq> x \<and> X = pre@x#suf"
proof -
  obtain x where "t \<sqsubseteq> x" "x \<in> set X" using assms by auto
  then obtain pre suf where "X = pre@x#suf" "x \<notin> set pre \<or> x \<notin> set suf"
    by (meson split_list_first split_list_last)
  thus ?thesis using \<open>t \<sqsubseteq> x\<close> by auto
qed

lemma ground_iff_no_vars: "ground (M::('a,'b) terms) \<longleftrightarrow> (\<forall>v. Var v \<notin> (\<Union>m \<in> M. subterms m))"
proof
  assume "ground M"
  hence "\<forall>v. \<forall>m \<in> M. v \<notin> fv m" by auto
  hence "\<forall>v. \<forall>m \<in> M. Var v \<notin> subterms m" by (simp add: vars_iff_subtermeq)
  thus "(\<forall>v. Var v \<notin> (\<Union>m \<in> M. subterms m))" by simp
next
  assume no_vars: "\<forall>v. Var v \<notin> (\<Union>m \<in> M. subterms m)"
  moreover
  { assume "\<not>ground M"
    then obtain v and m::"('a,'b) term" where "m \<in> M" "fv m \<noteq> {}" "v \<in> fv m" by auto
    hence "Var v \<in> (subterms m)" by (simp add: vars_iff_subtermeq)
    hence "\<exists>v. Var v \<in> (\<Union>t \<in> M. subterms t)" using \<open>m \<in> M\<close> by auto
    hence False using no_vars by simp
  }
  ultimately show "ground M" by blast
qed

lemma index_Fun_subterms_subset[simp]: "i < length T \<Longrightarrow> subterms (T ! i) \<subseteq> subterms (Fun f T)"
by auto

lemma index_Fun_fv_subset[simp]: "i < length T \<Longrightarrow> fv (T ! i) \<subseteq> fv (Fun f T)"
using subtermeq_vars_subset by fastforce

lemma subterms_union_ground:
  assumes "ground M"
  shows "ground (subterms\<^sub>s\<^sub>e\<^sub>t M)"
proof -
  { fix t assume "t \<in> M"
    hence "fv t = {}"
      using ground_iff_no_vars[of M] assms
      by auto
    hence "\<forall>t' \<in> subterms t. fv t' = {}" using subtermeq_vars_subset[of _ t] by simp
    hence "ground (subterms t)" by auto
  }
  thus ?thesis by auto
qed

lemma Var_subtermeq: "t \<sqsubseteq> Var v \<Longrightarrow> t = Var v" by simp

lemma subterms_const: "subterms (Fun f []) = {Fun f []}" by simp

lemma subterm_subtermeq_neq: "\<lbrakk>t \<sqsubset> u; u \<sqsubseteq> v\<rbrakk> \<Longrightarrow> t \<noteq> v"
  using term.dual_order.strict_trans1 by blast

lemma subtermeq_subterm_neq: "\<lbrakk>t \<sqsubseteq> u; u \<sqsubset> v\<rbrakk> \<Longrightarrow> t \<noteq> v"
by (metis term.order.eq_iff)

lemma subterm_size_lt: "x \<sqsubset> y \<Longrightarrow> size x < size y"
using not_less_eq size_list_estimation by (induct y, simp, fastforce)

lemma in_subterms_eq: "\<lbrakk>x \<in> subterms y; y \<in> subterms x\<rbrakk> \<Longrightarrow> subterms x = subterms y"
  using term.order.antisym by auto

lemma Fun_param_size_lt:
  "t \<in> set ts \<Longrightarrow> size t < size (Fun f ts)"
by (induct ts) auto

lemma Fun_zip_size_lt:
  assumes "(t,s) \<in> set (zip ts ss)"
  shows "size t < size (Fun f ts)"
    and "size s < size (Fun g ss)"
by (metis assms Fun_param_size_lt in_set_zipE)+

lemma Fun_gt_params: "Fun f X \<notin> (\<Union>x \<in> set X. subterms x)"
proof -
  have "size_list size X < size (Fun f X)" by simp
  hence "Fun f X \<notin> set X" by (meson less_not_refl size_list_estimation)
  hence "\<forall>x \<in> set X. Fun f X \<notin> subterms x \<or> x \<notin> subterms (Fun f X)"
    using subtermeq_subterm_neq by blast
  moreover have "\<forall>x \<in> set X. x \<in> subterms (Fun f X)" by fastforce
  ultimately show ?thesis by auto
qed

lemma params_subterms[simp]: "set X \<subseteq> subterms (Fun f X)" by auto

lemma params_subterms_Union[simp]: "subterms\<^sub>s\<^sub>e\<^sub>t (set X) \<subseteq> subterms (Fun f X)" by auto

lemma Fun_subterm_inside_params: "t \<sqsubset> Fun f X \<longleftrightarrow> t \<in> (\<Union>x \<in> (set X). subterms x)"
using Fun_gt_params by fastforce

lemma Fun_param_is_subterm: "x \<in> set X \<Longrightarrow> x \<sqsubset> Fun f X"
using Fun_subterm_inside_params by fastforce

lemma Fun_param_in_subterms: "x \<in> set X \<Longrightarrow> x \<in> subterms (Fun f X)"
using Fun_subterm_inside_params by fastforce

lemma Fun_not_in_param: "x \<in> set X \<Longrightarrow> \<not>Fun f X \<sqsubset> x"
  by (meson Fun_param_in_subterms term.less_le_not_le)

lemma Fun_ex_if_subterm: "t \<sqsubset> s \<Longrightarrow> \<exists>f T. Fun f T \<sqsubseteq> s \<and> t \<in> set T"
proof (induction s)
  case (Fun f T)
  then obtain s' where s': "s' \<in> set T" "t \<sqsubseteq> s'" by auto
  show ?case
  proof (cases "t = s'")
    case True thus ?thesis using s' by blast
  next
    case False
    thus ?thesis
      using Fun.IH[OF s'(1)] s'(2) term.order_trans[OF _ Fun_param_in_subterms[OF s'(1), of f]]
      by metis
  qed
qed simp

lemma const_subterm_obtain:
  assumes "fv t = {}"
  obtains c where "Fun c [] \<sqsubseteq> t"
using assms
proof (induction t)
  case (Fun f T) thus ?case by (cases "T = []") force+
qed simp

lemma const_subterm_obtain': "fv t = {} \<Longrightarrow> \<exists>c. Fun c [] \<sqsubseteq> t"
by (metis const_subterm_obtain)

lemma subterms_singleton:
  assumes "(\<exists>v. t = Var v) \<or> (\<exists>f. t = Fun f [])"
  shows "subterms t = {t}"
using assms by (cases t) auto

lemma subtermeq_Var_const:
  assumes "s \<sqsubseteq> t"
  shows "t = Var v \<Longrightarrow> s = Var v" "t = Fun f [] \<Longrightarrow> s = Fun f []"
using assms by fastforce+

lemma subterms_singleton':
  assumes "subterms t = {t}"
  shows "(\<exists>v. t = Var v) \<or> (\<exists>f. t = Fun f [])"
proof (cases t)
  case (Fun f T)
  { fix s S assume "T = s#S"
    hence "s \<in> subterms t" using Fun by auto
    hence "s = t" using assms by auto
    hence False
      using Fun_param_is_subterm[of s "s#S" f] \<open>T = s#S\<close> Fun
      by auto
  }
  hence "T = []" by (cases T) auto
  thus ?thesis using Fun by simp
qed (simp add: assms)

lemma funs_term_subterms_eq[simp]:
  "(\<Union>s \<in> subterms t. funs_term s) = funs_term t"
  "(\<Union>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. funs_term s) = \<Union>(funs_term ` M)"
proof -
  show "\<And>t. \<Union>(funs_term ` subterms t) = funs_term t"
    using term.order_refl subtermeq_imp_funs_term_subset by blast
  thus "\<Union>(funs_term ` (subterms\<^sub>s\<^sub>e\<^sub>t M)) = \<Union>(funs_term ` M)" by force
qed

lemmas subtermI'[intro] = Fun_param_is_subterm

lemma funs_term_Fun_subterm: "f \<in> funs_term t \<Longrightarrow> \<exists>T. Fun f T \<in> subterms t"
proof (induction t)
  case (Fun g T)
  hence "f = g \<or> (\<exists>s \<in> set T. f \<in> funs_term s)" by simp
  thus ?case
  proof
    assume "\<exists>s \<in> set T. f \<in> funs_term s"
    then obtain s where "s \<in> set T" "\<exists>T. Fun f T \<in> subterms s" using Fun.IH by auto
    thus ?thesis by auto
  qed (auto simp add: Fun)
qed simp

lemma funs_term_Fun_subterm': "Fun f T \<in> subterms t \<Longrightarrow> f \<in> funs_term t"
by (induct t) auto

lemma fv_disj_Fun_subterm_param_cases:
  assumes "fv t \<inter> X = {}" "Fun f T \<in> subterms t"
  shows "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` X)"
proof (cases T)
  case (Cons s S)
  hence "s \<in> subterms t"
    using assms(2) term.order_trans[of _ "Fun f T" t]
    by auto
  hence "fv s \<inter> X = {}" using assms(1) fv_subterms by force
  thus ?thesis using Cons by auto
qed simp

lemma fv_eq_FunI:
  assumes "length T = length S" "\<And>i. i < length T \<Longrightarrow> fv (T ! i) = fv (S ! i)"
  shows "fv (Fun f T) = fv (Fun g S)"
using assms
proof (induction T arbitrary: S)
  case (Cons t T S')
  then obtain s S where S': "S' = s#S" by (cases S') simp_all
  have "fv (T ! i) = fv (S ! i)" when "i < length T" for i
    using that Cons.prems(2)[of "Suc i"] unfolding S' by simp
  hence "fv (Fun f T) = fv (Fun g S)"
    using Cons.prems(1) Cons.IH[of S] unfolding S' by simp
  thus ?case using Cons.prems(2)[of 0] unfolding S' by auto
qed simp

lemma fv_eq_FunI':
  assumes "length T = length S" "\<And>i. i < length T \<Longrightarrow> x \<in> fv (T ! i) \<longleftrightarrow> x \<in> fv (S ! i)"
  shows "x \<in> fv (Fun f T) \<longleftrightarrow> x \<in> fv (Fun g S)"
using assms
proof (induction T arbitrary: S)
  case (Cons t T S')
  then obtain s S where S': "S' = s#S" by (cases S') simp_all
  show ?case using Cons.prems Cons.IH[of S] unfolding S' by fastforce
qed simp

lemma funs_term_eq_FunI:
  assumes "length T = length S" "\<And>i. i < length T \<Longrightarrow> funs_term (T ! i) = funs_term (S ! i)"
  shows "funs_term (Fun f T) = funs_term (Fun f S)"
using assms
proof (induction T arbitrary: S)
  case (Cons t T S')
  then obtain s S where S': "S' = s#S" by (cases S') simp_all
  have "funs_term (T ! i) = funs_term (S ! i)" when "i < length T" for i
    using that Cons.prems(2)[of "Suc i"] unfolding S' by simp
  hence "funs_term (Fun f T) = funs_term (Fun f S)"
    using Cons.prems(1) Cons.IH[of S] unfolding S' by simp
  thus ?case using Cons.prems(2)[of 0] unfolding S' by auto
qed simp

lemma finite_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[simp]: "finite (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s x)" by auto

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_Nil[simp]: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s [] = {}" by simp

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_singleton[simp]: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s [(t,s)] = fv t \<union> fv s" by simp

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_Cons: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) = fv s \<union> fv t \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" by simp

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" by simp

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono: "set M \<subseteq> set N \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s M \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s N" by auto

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI[intro]:
  "f \<in> set F \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r f \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
  "f \<in> set F \<Longrightarrow> x \<in> fv (fst f) \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
  "f \<in> set F \<Longrightarrow> x \<in> fv (snd f) \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
  "(t,s) \<in> set F \<Longrightarrow> x \<in> fv t \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
  "(t,s) \<in> set F \<Longrightarrow> x \<in> fv s \<Longrightarrow> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
using UN_I by fastforce+

lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_cons_subset: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F)"
by auto

lemma in_Fun_fv_iff_in_args_nth_fv:
  "x \<in> fv (Fun f ts) \<longleftrightarrow> (\<exists>i < length ts. x \<in> fv (ts ! i))"
  (is "?A \<longleftrightarrow> ?B")
proof
  assume ?A
  hence "x \<in> \<Union>(fv ` set ts)" by auto
  thus ?B by (metis UN_E in_set_conv_nth)
qed auto

subsection \<open>Other lemmata\<close>
lemma nonvar_term_has_composed_shallow_term:
  fixes t::"('f,'v) term"
  assumes "\<not>(\<exists>x. t = Var x)"
  shows "\<exists>f T. Fun f T \<sqsubseteq> t \<and> (\<forall>s \<in> set T. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x))"
proof -
  let ?Q = "\<lambda>S. \<forall>s \<in> set S. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x)"
  let ?P = "\<lambda>t. \<exists>g S. Fun g S \<sqsubseteq> t \<and> ?Q S"
  { fix t::"('f,'v) term"
    have "(\<exists>x. t = Var x) \<or> ?P t"
    proof (induction t)
      case (Fun h R) show ?case
      proof (cases "R = [] \<or> (\<forall>r \<in> set R. \<exists>x. r = Var x)")
        case False
        then obtain r g S where "r \<in> set R" "?P r" "Fun g S \<sqsubseteq> r" "?Q S" using Fun.IH by fast
        thus ?thesis by auto
      qed force
    qed simp
  } thus ?thesis using assms by blast
qed

end


theory Eurovision_Rule
imports Scoring_Rules
        "Compositional_Structures/Basic_Modules/Scoring_Module"
        "Compositional_Structures/Basic_Modules/Eurovision_Module"
        "Compositional_Structures/Elect_Composition"

begin

lemma euro_elect:
  shows "electoral_module (elector euro)"
proof(unfold euro.simps)
  show "electoral_module (elector (max_eliminator (scoring vector_A_euro)))"
    using scoring_mod_A by blast
qed

lemma euro_hom:
  shows "homogeneity (elector euro)" unfolding euro.simps
  using scoring_rules_homogeneity
  by blast

lemma euro_reinforcement:
  shows "reinforcement_complete (elector euro)" unfolding euro.simps
  using scoring_module_rein
  by blast

end


theory IMO_1959_Q1
imports Main
begin

lemma foo: "2 + 2 = 4"
  by auto

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_mccarthy91_M2
imports "../../Test_Base"
begin

(*fun did not finish the proof*)
function m :: "int => int" where
"m x = (if x > 100 then x - 10 else m (m (x + 11)))"
by pat_completeness auto

theorem property0 :
  "((n >= 101) ==> ((m n) = (n - 10)))"
  oops

end


theory Example
imports Information_Algebras
begin

(* Example *)

locale example =
  fixes "a" :: 'var and b :: "'var" and a0 :: "'val" and a1 :: "'val" and b0 :: "'val" and b1 :: "'val"
  assumes distinct_variables[simp]: "a \<noteq> b"
  assumes distinct_values_a[simp]: "a0 \<noteq> a1"
  assumes distinct_values_b[simp]: "b0 \<noteq> b1"

begin

lemma distinct_variables'[simp]: "b \<noteq> a" by (clarsimp, drule sym, clarsimp)

lemma distinct_values_a'[simp]: "a1 \<noteq> a0" by (clarsimp, drule sym, clarsimp)

lemma distinct_values_b'[simp]: "b1 \<noteq> b0" by (clarsimp, drule sym, clarsimp)

definition V :: "'var set"
  where "V = {a, b}"

definition V_opens :: "'var set set"
  where "V_opens = {{a}, {b}, {a,b}, {}}"

lemma V_opens_simps[simp]: "{a} \<in> V_opens"  "{b} \<in> V_opens"  "{a, b} \<in> V_opens"  "{} \<in> V_opens"
  by (clarsimp simp: V_opens_def)+

sublocale  topological_space V_opens V
  apply (standard; clarsimp simp: V_opens_def V_def)
    apply (blast)
   apply (blast)
  by (blast)

definition Omega_a :: "'val rel"
  where "Omega_a = {(a0, a0), (a0, a1), (a1, a1)}"

definition Omega_b :: "'val rel"
  where "Omega_b = {(b0, b0), (b0, b1), (b1, b1)}"

(* Mapping from variables to prosets *)

definition Omega :: "'var \<Rightarrow> ('val rel) "
  where "Omega v = (if v = a then (Omega_a) else if v = b then Omega_b else undefined)"

lemma Omega_simps[simp]:  "Omega a = {(a0, a0), (a0, a1), (a1, a1)}" by (clarsimp simp: Omega_def Omega_a_def)

lemma Omega_simps'[simp]: "Omega b =  {(b0, b0), (b0, b1), (b1, b1)}" by (clarsimp simp: Omega_def Omega_b_def)

sublocale Omega V_opens V Omega
  apply (standard)
   apply (rule transI; clarsimp simp: V_def Omega_b_def Omega_def Omega_a_def split: if_splits)
    apply (blast)
  apply (blast)
  apply (rule refl_onI)
   apply (clarsimp simp: V_def Omega_b_def Omega_def Omega_a_def  carrier_def split: if_splits )
  by (clarsimp simp: V_def Omega_b_def Omega_def Omega_a_def  carrier_def split: if_splits)

definition t :: "('var \<times> 'val) set list "
  where "t = [{(a, a0), (b, b0)}, {(a, a1), (b, b0)}, {(a, a1), (b, b1)}]"

definition t' :: "('var \<times> 'val) set list "
  where "t' = [{(a, a0), (b, b0)}, {(a, a1), (b, b1)}]"

lemma carrier_insert_simp[simp]: "carrier (insert (x,y) S) = {x, y} \<union> carrier S"
  by (clarsimp simp: carrier_def, safe)

lemma t_is_trace_of_chaos: "(t) \<in> \<Union>(snd ` chaos ` V_opens)"
  apply (clarsimp simp: image_iff chaos_def)
  apply (rule_tac x="{a,b}" in bexI)
   apply (clarsimp simp: chaos_obj_def nondegen_def)
   apply (intro conjI)
    apply (rule_tac x="length t" in exI)
    apply (clarsimp simp: nerve_obj_def)
    apply (clarsimp simp: t_def)
    apply (rule cons_step)
     apply (rule cons_step)
      apply (rule single)
      apply (clarsimp simp: carrier_om_iff single_valued_def)
     apply (clarsimp simp: om_iff single_valued_def)
  apply (clarsimp simp: om_iff single_valued_def)
   apply (clarsimp simp: distinct_adj_def t_def)
   apply (simp add: doubleton_eq_iff)
  apply (clarsimp simp: V_opens_def)
  done

lemma t'_is_trace_of_chaos: "(t') \<in> \<Union>(snd ` chaos ` V_opens)"
  apply (clarsimp simp: image_iff chaos_def)
  apply (rule_tac x="{a,b}" in bexI)
   apply (clarsimp simp: chaos_obj_def nondegen_def)
   apply (intro conjI)
    apply (rule_tac x="length t'" in exI)
    apply (clarsimp simp: nerve_obj_def)
    apply (clarsimp simp: t'_def)
    apply (rule cons_step)
     apply (rule single)
     apply (clarsimp simp: carrier_om_iff single_valued_def)
     apply (clarsimp simp: om_iff single_valued_def)
   apply (clarsimp simp: distinct_adj_def t'_def)
   apply (simp add: doubleton_eq_iff)
  apply (clarsimp simp: V_opens_def)
  done

definition U :: "'var set"
  where "U = {a}"

lemma restrict_t_to_U: "down (({a, b}, {t}), U) = ({a}, {[{(a, a0)}, {(a, a1)}]})"
  apply (clarsimp simp: down_def chaos_fun'_def )
  apply (safe; clarsimp simp: U_def)
  apply (clarsimp simp: chaos_obj_def nondegen_def)
    apply (clarsimp simp: chaos_fun_def mapf_def)
    apply (subst t_def, clarsimp)
 apply (clarsimp simp: chaos_obj_def nondegen_def)
   apply (intro conjI)
    apply (rule_tac x="length t" in exI)
    apply (clarsimp simp: nerve_obj_def)
    apply (clarsimp simp: t_def)
    apply (rule cons_step)
     apply (rule cons_step)
      apply (rule single)
      apply (subst carrier_om_iff, clarsimp simp: V_opens_def)
      apply (clarsimp simp: single_valued_def)
     apply (clarsimp simp: \<Omega>_def)
  apply (intro conjI; (clarsimp simp: single_valued_def)?)
   apply (clarsimp simp: \<Omega>_def)
  apply (intro conjI; (clarsimp simp: single_valued_def)?)
   apply (clarsimp simp: distinct_adj_def t_def)
   apply (simp add: doubleton_eq_iff)
  apply (clarsimp simp: chaos_fun_def relcomp.simps, clarsimp simp: mapf_def)
  apply (intro conjI)
   apply (clarsimp simp: rest_def image_iff)
   apply (clarsimp simp: carrier_om_iff)
   apply (intro conjI)
     apply (clarsimp simp: t_def, elim disjE; blast)
    apply (clarsimp simp: t_def single_valued_def)
    apply (elim disjE)
      apply auto[1]
  apply auto[1]
    apply auto[1]
   apply (clarsimp simp: t_def)
   apply (elim disjE; clarsimp, elim disjE; clarsimp simp: carrier_def Omega_def Omega_a_def Omega_b_def)
  apply (clarsimp simp: t_def)
  done

lemma restrict_t'_to_U: "down (({a, b}, {t'}), U) = ({a}, {[{(a, a0)}, {(a, a1)}]})"
   apply (clarsimp simp: down_def chaos_fun'_def )
  apply (safe; clarsimp simp: U_def)
  apply (clarsimp simp: chaos_obj_def nondegen_def)
    apply (clarsimp simp: chaos_fun_def mapf_def)
    apply (subst t'_def, clarsimp)
 apply (clarsimp simp: chaos_obj_def nondegen_def)
   apply (intro conjI)
    apply (rule_tac x="length t'" in exI)
    apply (clarsimp simp: nerve_obj_def)
    apply (clarsimp simp: t'_def)
    apply (rule cons_step)
      apply (rule single)
      apply (subst carrier_om_iff, clarsimp simp: V_opens_def)
      apply (clarsimp simp: single_valued_def)
     apply (clarsimp simp: \<Omega>_def)
  apply (intro conjI; (clarsimp simp: single_valued_def)?)
   apply (clarsimp simp: distinct_adj_def t'_def)
   apply (simp add: doubleton_eq_iff)
  apply (clarsimp simp: chaos_fun_def relcomp.simps, clarsimp simp: mapf_def)
  apply (intro conjI)
   apply (clarsimp simp: rest_def image_iff)
   apply (clarsimp simp: carrier_om_iff)
   apply (intro conjI)
     apply (clarsimp simp: t'_def, elim disjE; blast)
    apply (clarsimp simp: t'_def single_valued_def)
    apply (elim disjE)
      apply auto[1]
  apply auto[1]
    apply auto[1]
   apply (clarsimp simp: t'_def)
   apply (elim disjE; clarsimp, elim disjE; clarsimp simp: carrier_def Omega_def Omega_a_def Omega_b_def)
  apply (clarsimp simp: t'_def)
  done

end

end


(*  Title:      statecharts/Examples/CarAudioSystem.thy

    Author:     Steffen Helke and Florian Kammüller, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

header {* Example Specification for a Car Audio System *}

theory CarAudioSystem
imports "HAKripke" "HAOps"
begin

subsection {* Definitions *}

subsubsection {* Data space for two Integer-Variables *}

datatype d = V0 int
             | V1 int

primrec
 Sel0 :: "d => int" where
  "Sel0 (V0 i) = i"

primrec
 Sel1 :: "d => int" where
  "Sel1 (V1 i) = i"

(* Selectors for the two Integer-Variables *)
definition
  Select0 :: "[d data] => int" where
  "Select0 d = Sel0 (DataPart d 0)"

definition
  Select1 :: "[d data] => int" where
  "Select1 d = Sel1 (DataPart d 1)"

(* Data Space for tthe two Integer-Variables *)
definition
  DSpace :: "d dataspace" where
  "DSpace = Abs_dataspace ([range V0, range V1])"

(* Lift in InitData *)
definition
  LiftInitData :: "(d list) => d data" where
  "LiftInitData L = Abs_data (L,DSpace)"

(* Lift in PUpdate-Function *)
definition
  LiftPUpdate :: "(d data => ((d option) list)) => d pupdate" where
  "LiftPUpdate L = Abs_pupdate
                        (\<lambda> d. if ((DataSpace d) = DSpace) then
                                   Abs_pdata (L d, DSpace)
                              else (Data2PData d))"

subsubsection {* Sequential Automaton  @{text "Root_CTRL"} *}

definition
 Root_CTRL_States :: "string set" where
 "Root_CTRL_States = {''CarAudioSystem''}"

definition
 Root_CTRL_Init :: "string" where
 "Root_CTRL_Init = ''CarAudioSystem''"

definition
 Root_CTRL_Labels :: "(string,string,d)label set" where
 "Root_CTRL_Labels = {}"

definition
 Root_CTRL_Delta :: "(string,string,d)trans set" where
 "Root_CTRL_Delta = {}"

definition
 Root_CTRL :: "(string,string,d)seqauto" where
 "Root_CTRL = Abs_seqauto (Root_CTRL_States, Root_CTRL_Init,
                            Root_CTRL_Labels, Root_CTRL_Delta)"

subsubsection {* Sequential Automaton  @{text "CDPlayer_CTRL"} *}

definition
 CDPlayer_CTRL_States :: "string set" where
 "CDPlayer_CTRL_States = {''ReadTracks'',''CDFull'',''CDEmpty''}"

definition
 CDPlayer_CTRL_Init :: "string" where
 "CDPlayer_CTRL_Init = ''CDEmpty''"

definition
 CDPlayer_CTRL_Update1 :: "d pupdate" where
 "CDPlayer_CTRL_Update1 = LiftPUpdate (% d. [None, Some (V1 ((Select0 d) + 1))])"

definition
 CDPlayer_CTRL_Action1 :: "(string,d)action" where
 "CDPlayer_CTRL_Action1 = ({},CDPlayer_CTRL_Update1)"

definition
 CDPlayer_CTRL_Update2 :: "d pupdate" where
 "CDPlayer_CTRL_Update2 = LiftPUpdate (% d. [Some (V0 ((Select0 d) + 1)), None])"

definition
 CDPlayer_CTRL_Action2 :: "(string,d)action" where
 "CDPlayer_CTRL_Action2 = ({},CDPlayer_CTRL_Update2)"

definition
 CDPlayer_CTRL_Update3 :: "d pupdate" where
 "CDPlayer_CTRL_Update3 = LiftPUpdate (% d. [Some (V0 0), None])"

definition
 CDPlayer_CTRL_Action3 :: "(string,d)action" where
 "CDPlayer_CTRL_Action3 = ({},CDPlayer_CTRL_Update3)"

definition
 CDPlayer_CTRL_Labels :: "(string,string,d)label set" where
 "CDPlayer_CTRL_Labels = {(En ''LastTrack'', defaultguard, CDPlayer_CTRL_Action1),
                          (En ''NewTrack'', defaultguard, CDPlayer_CTRL_Action2),
                          (And (En ''CDEject'') (In ''On''), defaultguard, CDPlayer_CTRL_Action3),
                          (En ''CDIn'', defaultguard, defaultaction)}"

definition
 CDPlayer_CTRL_Delta :: "(string,string,d)trans set" where
 "CDPlayer_CTRL_Delta = {(''ReadTracks'',(En ''LastTrack'', defaultguard, CDPlayer_CTRL_Action1),
                          ''CDFull''),
                         (''CDFull'',(And (En ''CDEject'') (In ''On''), defaultguard, CDPlayer_CTRL_Action3),
                          ''CDEmpty''),
                         (''ReadTracks'',(En ''NewTrack'', defaultguard, CDPlayer_CTRL_Action2),
                          ''ReadTracks''),
                         (''CDEmpty'',(En ''CDIn'', defaultguard, defaultaction),
                          ''ReadTracks'')}"

definition
 CDPlayer_CTRL :: "(string,string,d)seqauto" where
 "CDPlayer_CTRL  = Abs_seqauto (CDPlayer_CTRL_States, CDPlayer_CTRL_Init,
                                CDPlayer_CTRL_Labels, CDPlayer_CTRL_Delta)"

subsubsection {* Sequential Automaton  @{text "AudioPlayer_CTRL"} *}

definition
 AudioPlayer_CTRL_States :: "string set" where
 "AudioPlayer_CTRL_States = {''Off'',''On''}"

definition
 AudioPlayer_CTRL_Init :: "string" where
 "AudioPlayer_CTRL_Init = ''Off''"

definition
 AudioPlayer_CTRL_Labels :: "(string,string,d)label set" where
 "AudioPlayer_CTRL_Labels = {(En ''O'', defaultguard, defaultaction)}"

definition
 AudioPlayer_CTRL_Delta :: "(string,string,d)trans set" where
 "AudioPlayer_CTRL_Delta = {(''Off'', (En ''O'', defaultguard, defaultaction), ''On''),
                            (''On'', (En ''O'', defaultguard, defaultaction), ''Off'')}"

definition
 AudioPlayer_CTRL :: "(string,string,d)seqauto" where
 "AudioPlayer_CTRL = Abs_seqauto (AudioPlayer_CTRL_States, AudioPlayer_CTRL_Init,
                                  AudioPlayer_CTRL_Labels, AudioPlayer_CTRL_Delta)"

subsubsection {* Sequential Automaton  @{text "On_CTRL"} *}

definition
 On_CTRL_States :: "string set" where
 "On_CTRL_States = {''TunerMode'',''CDMode''}"

definition
 On_CTRL_Init :: "string" where
 "On_CTRL_Init = ''TunerMode''"

definition
 On_CTRL_Labels :: "(string,string,d)label set" where
 "On_CTRL_Labels = {(And (En ''Src'') (In ''CDFull''), defaultguard, defaultaction),
                    (En ''Src'', defaultguard, defaultaction),
                    (En ''CDEject'', defaultguard, defaultaction),
                    (En ''EndOfTitle'', (\<lambda> d. (DataPart d 0) =  (DataPart d 1)), defaultaction)}"

definition
 On_CTRL_Delta :: "(string,string,d)trans set" where
 "On_CTRL_Delta = {(''TunerMode'',(And (En ''Src'') (In ''CDFull''), defaultguard, defaultaction),''CDMode''),
                   (''CDMode'', (En ''Src'', defaultguard, defaultaction), ''TunerMode''),
                   (''CDMode'', (En ''CDEject'', defaultguard, defaultaction), ''TunerMode''),
                   (''CDMode'', (En ''EndOfTitle'', (\<lambda> d. (DataPart d 0) =  (DataPart d 1)), defaultaction),
                    ''TunerMode'')}"

definition
 On_CTRL :: "(string,string,d)seqauto" where
 "On_CTRL = Abs_seqauto (On_CTRL_States, On_CTRL_Init,
                         On_CTRL_Labels, On_CTRL_Delta)"

subsubsection {* Sequential Automaton  @{text "TunerMode_CTRL"} *}

definition
 TunerMode_CTRL_States :: "string set" where
 "TunerMode_CTRL_States = {''1'',''2'',''3'',''4''}"

definition
 TunerMode_CTRL_Init :: "string" where
 "TunerMode_CTRL_Init = ''1''"

definition
 TunerMode_CTRL_Labels :: "(string,string,d)label set" where
 "TunerMode_CTRL_Labels = {(En ''Next'', defaultguard, defaultaction),
                       (En ''Back'', defaultguard, defaultaction)}"

definition
 TunerMode_CTRL_Delta :: "(string,string,d)trans set" where
 "TunerMode_CTRL_Delta = {(''1'', (En ''Next'', defaultguard, defaultaction), ''2''),
                      (''2'', (En ''Next'', defaultguard, defaultaction), ''3''),
                      (''3'', (En ''Next'', defaultguard, defaultaction), ''4''),
                      (''4'', (En ''Next'', defaultguard, defaultaction), ''1''),
                      (''1'', (En ''Back'', defaultguard, defaultaction), ''4''),
                      (''4'', (En ''Back'', defaultguard, defaultaction), ''3''),
                      (''3'', (En ''Back'', defaultguard, defaultaction), ''2''),
                      (''2'', (En ''Back'', defaultguard, defaultaction), ''1'')}"

definition
 TunerMode_CTRL :: "(string,string,d)seqauto" where
 "TunerMode_CTRL  = Abs_seqauto (TunerMode_CTRL_States, TunerMode_CTRL_Init,
                                  TunerMode_CTRL_Labels, TunerMode_CTRL_Delta)"

subsubsection {* Sequential Automaton  @{text "CDMode_CTRL"} *}

definition
 CDMode_CTRL_States :: "string set" where
 "CDMode_CTRL_States = {''Playing'',''SelectingNextTrack'',
                        ''SelectingPreviousTrack''}"

definition
 CDMode_CTRL_Init :: "string" where
 "CDMode_CTRL_Init = ''Playing''"

definition
 CDMode_CTRL_Update1 :: "d pupdate" where
 "CDMode_CTRL_Update1 = LiftPUpdate (% d. [ Some (V0 ((Select0 d) + 1)), None ])"

definition
 CDMode_CTRL_Action1 :: "(string,d)action" where
 "CDMode_CTRL_Action1 = ({},CDMode_CTRL_Update1)"

definition
 CDMode_CTRL_Update2 :: "d pupdate" where
 "CDMode_CTRL_Update2 = LiftPUpdate (% d. [ Some (V0 ((Select0 d) - 1)), None ])"

definition
 CDMode_CTRL_Action2 :: "(string,d)action" where
 "CDMode_CTRL_Action2 = ({},CDMode_CTRL_Update2)"

definition
 CDMode_CTRL_Labels :: "(string,string,d)label set" where
 "CDMode_CTRL_Labels = {(En ''Next'', defaultguard, defaultaction),
                        (En ''Back'', defaultguard, defaultaction),
                        (En ''Ready'', defaultguard, CDMode_CTRL_Action1),
                        (En ''Ready'', defaultguard, CDMode_CTRL_Action2),
                        (En ''EndOfTitle'',(\<lambda> (d:: d data). (Select0 d) < (Select1 d)), defaultaction)}"

definition
 CDMode_CTRL_Delta :: "(string,string,d)trans set" where
 "CDMode_CTRL_Delta = {(''Playing'', (En ''Next'', defaultguard, defaultaction) , ''SelectingNextTrack''),
                       (''SelectingNextTrack'', (En ''Ready'', defaultguard, CDMode_CTRL_Action1) ,''Playing''),
                       (''Playing'', (En ''Back'', defaultguard, defaultaction) ,''SelectingPreviousTrack''),
                       (''SelectingPreviousTrack'', (En ''Ready'', defaultguard, CDMode_CTRL_Action2),
                        ''Playing''),
                       (''Playing'', (En ''EndOfTitle'', (\<lambda> (d:: d data). (Select0 d) < (Select1 d)), defaultaction),
                        ''SelectingNextTrack'')}"

definition
 CDMode_CTRL :: "(string,string,d)seqauto" where
 "CDMode_CTRL  = Abs_seqauto (CDMode_CTRL_States, CDMode_CTRL_Init,
                               CDMode_CTRL_Labels, CDMode_CTRL_Delta)"

subsubsection {* Hierarchical Automaton  @{text "CarAudioSystem"} *}

definition
     CarAudioSystem :: "(string,string,d)hierauto" where
     "CarAudioSystem = ((PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0]))
                  [++] (''CarAudioSystem'',CDPlayer_CTRL)
                  [++] (''CarAudioSystem'',AudioPlayer_CTRL)
                  [++] (''On'', TunerMode_CTRL)
                  [++] (''On'', CDMode_CTRL))"

subsection {* Lemmas *}

subsubsection {* Sequential Automaton @{text "CDMode_CTRL"} *}

lemma check_Root_CTRL:
  "(Root_CTRL_States,Root_CTRL_Init,Root_CTRL_Labels,Root_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def Root_CTRL_States_def Root_CTRL_Init_def Root_CTRL_Labels_def Root_CTRL_Delta_def)
apply simp
done

lemma States_Root_CTRL:
  "States Root_CTRL = Root_CTRL_States";
apply (simp add: Root_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_Root_CTRL)
done

lemma Init_State_Root_CTRL:
  "InitState Root_CTRL = Root_CTRL_Init";
apply (simp add: Root_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_Root_CTRL)
done

lemma Labels_Root_CTRL:
  "Labels Root_CTRL = Root_CTRL_Labels";
apply (simp add: Root_CTRL_def)
apply (unfold Labels_def)
apply (simp add: Abs_seqauto_inverse check_Root_CTRL)
done

lemma Delta_Root_CTRL:
  "Delta Root_CTRL = Root_CTRL_Delta";
apply (simp add: Root_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_Root_CTRL)
done

schematic_lemma Events_Root_CTRL:
  "SAEvents Root_CTRL = ?X"
apply (unfold SAEvents_def expr_def)
apply (rule trans)
apply (simp add: expr_def Delta_Root_CTRL Root_CTRL_Delta_def)
apply (rule refl)
done

subsubsection {* Sequential Automaton @{text "CDPlayer_CTRL"} *}

lemma check_CDPlayer_CTRL:
  "(CDPlayer_CTRL_States,CDPlayer_CTRL_Init,CDPlayer_CTRL_Labels,CDPlayer_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def CDPlayer_CTRL_States_def CDPlayer_CTRL_Init_def CDPlayer_CTRL_Labels_def CDPlayer_CTRL_Delta_def)
apply simp
done

lemma States_CDPlayer_CTRL:
  "States CDPlayer_CTRL = CDPlayer_CTRL_States";
apply (simp add: CDPlayer_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_CDPlayer_CTRL)
done

lemma Init_State_CDPlayer_CTRL:
  "InitState CDPlayer_CTRL = CDPlayer_CTRL_Init";
apply (simp add: CDPlayer_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_CDPlayer_CTRL)
done

lemma Labels_CDPlayer_CTRL:
  "Labels CDPlayer_CTRL = CDPlayer_CTRL_Labels";
apply (simp add: CDPlayer_CTRL_def)
apply (unfold Labels_def)
apply (simp add: Abs_seqauto_inverse check_CDPlayer_CTRL)
done

lemma Delta_CDPlayer_CTRL:
  "Delta CDPlayer_CTRL = CDPlayer_CTRL_Delta";
apply (simp add: CDPlayer_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_CDPlayer_CTRL)
done

schematic_lemma Events_CDPlayer_CTRL:
  "SAEvents CDPlayer_CTRL = ?X"
apply (unfold SAEvents_def)
apply (rule trans)
apply (simp add: expr_def Delta_CDPlayer_CTRL CDPlayer_CTRL_Delta_def CDPlayer_CTRL_Action1_def CDPlayer_CTRL_Action2_def CDPlayer_CTRL_Action3_def Label_def)
apply (rule refl)
done

subsubsection {* Sequential Automaton @{text "AudioPlayer_CTRL"} *}

lemma check_AudioPlayer_CTRL:
  "(AudioPlayer_CTRL_States,AudioPlayer_CTRL_Init,AudioPlayer_CTRL_Labels,AudioPlayer_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def AudioPlayer_CTRL_States_def AudioPlayer_CTRL_Init_def AudioPlayer_CTRL_Labels_def AudioPlayer_CTRL_Delta_def)
apply simp
done

lemma States_AudioPlayer_CTRL:
  "States AudioPlayer_CTRL = AudioPlayer_CTRL_States";
apply (simp add: AudioPlayer_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_AudioPlayer_CTRL)
done

lemma Init_State_AudioPlayer_CTRL:
  "InitState AudioPlayer_CTRL = AudioPlayer_CTRL_Init";
apply (simp add: AudioPlayer_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_AudioPlayer_CTRL)
done

lemma Labels_AudioPlayer_CTRL:
  "Labels AudioPlayer_CTRL = AudioPlayer_CTRL_Labels";
apply (simp add: AudioPlayer_CTRL_def)
apply (unfold Labels_def)
apply (simp add: Abs_seqauto_inverse check_AudioPlayer_CTRL)
done

lemma Delta_AudioPlayer_CTRL:
  "Delta AudioPlayer_CTRL = AudioPlayer_CTRL_Delta";
apply (simp add: AudioPlayer_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_AudioPlayer_CTRL)
done

schematic_lemma Events_AudioPlayer_CTRL:
  "SAEvents AudioPlayer_CTRL = ?X"
apply (unfold SAEvents_def)
apply (rule trans)
apply (simp add: expr_def Delta_AudioPlayer_CTRL AudioPlayer_CTRL_Delta_def Label_def)
apply (rule refl)
done

subsubsection {* Sequential Automaton @{text "On_CTRL"} *}

lemma check_On_CTRL:
  "(On_CTRL_States,On_CTRL_Init,On_CTRL_Labels,On_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def On_CTRL_States_def On_CTRL_Init_def On_CTRL_Labels_def On_CTRL_Delta_def)
apply simp
done

lemma States_On_CTRL:
  "States On_CTRL = On_CTRL_States";
apply (simp add: On_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_On_CTRL)
done

lemma Init_State_On_CTRL:
  "InitState On_CTRL = On_CTRL_Init";
apply (simp add: On_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_On_CTRL)
done

lemma Labels_On_CTRL:
  "Labels On_CTRL = On_CTRL_Labels";
apply (simp add: On_CTRL_def)
apply (unfold Labels_def)
apply (simp add: Abs_seqauto_inverse check_On_CTRL)
done

lemma Delta_On_CTRL:
  "Delta On_CTRL = On_CTRL_Delta";
apply (simp add: On_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_On_CTRL)
done

schematic_lemma Events_On_CTRL:
  "SAEvents On_CTRL = ?X"
apply (unfold SAEvents_def)
apply (rule trans)
apply (simp add: expr_def Delta_On_CTRL On_CTRL_Delta_def Label_def)
apply (rule refl)
done

subsubsection {* Sequential Automaton @{text "TunerMode_CTRL"} *}

lemma check_TunerMode_CTRL:
  "(TunerMode_CTRL_States,TunerMode_CTRL_Init,TunerMode_CTRL_Labels,TunerMode_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def TunerMode_CTRL_States_def TunerMode_CTRL_Init_def TunerMode_CTRL_Labels_def TunerMode_CTRL_Delta_def)
apply simp
done

lemma States_TunerMode_CTRL:
  "States TunerMode_CTRL = TunerMode_CTRL_States";
apply (simp add: TunerMode_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_TunerMode_CTRL)
done

lemma Init_State_TunerMode_CTRL:
  "InitState TunerMode_CTRL = TunerMode_CTRL_Init";
apply (simp add: TunerMode_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_TunerMode_CTRL)
done

lemma Delta_TunerMode_CTRL:
  "Delta TunerMode_CTRL = TunerMode_CTRL_Delta";
apply (simp add: TunerMode_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_TunerMode_CTRL)
done

schematic_lemma Events_TunerMode_CTRL:
  "SAEvents TunerMode_CTRL = ?X"
apply (unfold SAEvents_def)
apply (rule trans)
apply (simp add: expr_def Delta_TunerMode_CTRL TunerMode_CTRL_Delta_def Label_def)
apply (rule refl)
done

subsubsection {* Sequential Automaton @{text "CDMode_CTRL"} *}

lemma check_CDMode_CTRL:
  "(CDMode_CTRL_States,CDMode_CTRL_Init,CDMode_CTRL_Labels,CDMode_CTRL_Delta) : seqauto"
apply (unfold seqauto_def SeqAuto_def CDMode_CTRL_States_def CDMode_CTRL_Init_def CDMode_CTRL_Labels_def CDMode_CTRL_Delta_def)
apply simp
done

lemma States_CDMode_CTRL:
  "States CDMode_CTRL = CDMode_CTRL_States";
apply (simp add: CDMode_CTRL_def)
apply (unfold States_def)
apply (simp add: Abs_seqauto_inverse check_CDMode_CTRL)
done

lemma Init_State_CDMode_CTRL:
  "InitState CDMode_CTRL = CDMode_CTRL_Init";
apply (simp add: CDMode_CTRL_def)
apply (unfold InitState_def)
apply (simp add: Abs_seqauto_inverse check_CDMode_CTRL)
done

lemma Labels_CDMode_CTRL:
  "Labels CDMode_CTRL = CDMode_CTRL_Labels";
apply (simp add: CDMode_CTRL_def)
apply (unfold Labels_def)
apply (simp add: Abs_seqauto_inverse check_CDMode_CTRL)
done

lemma Delta_CDMode_CTRL:
  "Delta CDMode_CTRL = CDMode_CTRL_Delta";
apply (simp add: CDMode_CTRL_def)
apply (unfold Delta_def)
apply (simp add: Abs_seqauto_inverse check_CDMode_CTRL)
done

schematic_lemma Events_CDMode_CTRL:
  "SAEvents CDMode_CTRL = ?X"
apply (unfold SAEvents_def)
apply (rule trans)
apply (simp add: expr_def Label_def Delta_CDMode_CTRL CDMode_CTRL_Delta_def CDMode_CTRL_Action1_def CDMode_CTRL_Action2_def)
apply (rule refl)
done

subsubsection {*  Hierarchical Automaton @{text "CarAudioSystem"} *}

lemmas CarAudioSystemStates = States_Root_CTRL States_CDPlayer_CTRL States_AudioPlayer_CTRL States_On_CTRL
                              States_TunerMode_CTRL States_CDMode_CTRL
                              Root_CTRL_States_def CDPlayer_CTRL_States_def AudioPlayer_CTRL_States_def
                              On_CTRL_States_def TunerMode_CTRL_States_def CDMode_CTRL_States_def

lemmas CarAudioSystemInitState = Init_State_Root_CTRL Init_State_CDPlayer_CTRL Init_State_AudioPlayer_CTRL
                                 Init_State_On_CTRL Init_State_TunerMode_CTRL Init_State_CDMode_CTRL
                                 Root_CTRL_Init_def CDPlayer_CTRL_Init_def AudioPlayer_CTRL_Init_def
                                 On_CTRL_Init_def TunerMode_CTRL_Init_def CDMode_CTRL_Init_def

lemmas CarAudioSystemEvents = Events_Root_CTRL Events_CDPlayer_CTRL Events_AudioPlayer_CTRL Events_On_CTRL
                              Events_TunerMode_CTRL Events_CDMode_CTRL

lemmas CarAudioSystemthms = CarAudioSystemStates CarAudioSystemEvents CarAudioSystemInitState

(* -------------------------------------------------------------- *)
(*                  States of \<guillemotright> CarAudioSystem \<guillemotleft>                  *)
(* -------------------------------------------------------------- *)

schematic_lemma CarAudioSystem_StatesRoot:
  "HAStates (PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0])) = ?X"
apply (wellformed CarAudioSystemthms)+
done

lemmas CarAudioSystemthms_1 = CarAudioSystemthms CarAudioSystem_StatesRoot

schematic_lemma CarAudioSystem_StatesCDPlayer:
  "HAStates (PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0]) [++]
            (''CarAudioSystem'',CDPlayer_CTRL)) = ?X"
apply (wellformed CarAudioSystemthms_1)+
done

lemmas CarAudioSystemthms_2 = CarAudioSystemthms_1 CarAudioSystem_StatesCDPlayer

schematic_lemma CarAudioSystem_StatesAudioPlayer:
  "HAStates (PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0])
                  [++] (''CarAudioSystem'',CDPlayer_CTRL)
                  [++] (''CarAudioSystem'',AudioPlayer_CTRL)) = ?X"
apply (wellformed CarAudioSystemthms_2)+
done

lemmas CarAudioSystemthms_3 = CarAudioSystemthms_2 CarAudioSystem_StatesAudioPlayer

schematic_lemma CarAudioSystem_StatesTunerMode:
  "HAStates (PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0])
                  [++] (''CarAudioSystem'',CDPlayer_CTRL)
                  [++] (''CarAudioSystem'',AudioPlayer_CTRL)
                  [++] (''On'', TunerMode_CTRL )) = ?X"
apply (wellformed CarAudioSystemthms_3)+
done

lemmas CarAudioSystemthms_4 = CarAudioSystemthms_3 CarAudioSystem_StatesTunerMode

schematic_lemma CarAudioSystem_StatesCDMode:
  "HAStates (PseudoHA Root_CTRL (LiftInitData [V0 0, V1 0])
                  [++] (''CarAudioSystem'',CDPlayer_CTRL)
                  [++] (''CarAudioSystem'',AudioPlayer_CTRL)
                  [++] (''On'', TunerMode_CTRL )
                  [++] (''On'', CDMode_CTRL)) = ?X"
apply (wellformed CarAudioSystemthms_4)+
done

lemmas CarAudioSystemthms_5 = CarAudioSystemthms_4 CarAudioSystem_StatesCDMode

schematic_lemma SAsCarAudioSystem:
  "SAs CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma EventsCarAudioSystem:
 "HAEvents CarAudioSystem = ?X";
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma CompFunCarAudioSystem:
  "CompFun CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma StatesCarAudioSystem:
  "HAStates CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma ValueCarAudioSystem:
  "HAInitValue CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma HAInitStatesCarAudioSystem:
  "HAInitStates CarAudioSystem = ?X"
by (simp add: HAInitStates_def SAsCarAudioSystem CarAudioSystemInitState)

schematic_lemma HARootCarAudioSystem:
  "HARoot CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma HAInitStateCarAudioSystem:
  "HAInitState CarAudioSystem = ?X"
by (simp add: HARootCarAudioSystem HAInitState_def CarAudioSystemInitState)

(* -------------------------------------------------------------- *)
(*      Components of the initial data space assignement          *)
(* -------------------------------------------------------------- *)

lemma check_DataSpace [simp]:
  "[range V0, range V1] \<in> dataspace"
apply (unfold dataspace_def DataSpace.DataSpace_def)
apply auto
apply (rename_tac D)
apply (case_tac "D")
apply auto
done

lemma PartNum_DataSpace [simp]:
  "PartNum (DSpace) = 2"
apply (unfold PartNum_def DSpace_def)
apply (simp add: Abs_dataspace_inverse)
done

lemma PartDom_DataSpace_V0 [simp]:
  "(PartDom DSpace 0) = range V0"
apply (unfold PartDom_def DSpace_def)
apply (simp add: Abs_dataspace_inverse)
done

lemma PartDom_DataSpace_V1 [simp]:
  "(PartDom DSpace (Suc 0)) = range V1"
apply (unfold PartDom_def DSpace_def)
apply (simp add: Abs_dataspace_inverse)
done

lemma check_InitialData [simp]:
  "([V0 0, V1 0],DSpace) \<in> data"
apply (unfold data_def Data.Data_def)
apply auto
apply (rename_tac d)
apply (case_tac "d=0 \<or> d = 1")
apply auto
done

lemma Select0_InitData [simp]:
  "Select0 (LiftInitData [V0 0, V1 0]) = 0"
apply (unfold LiftInitData_def Select0_def DataPart_def DataValue_def)
apply (simp add: Abs_data_inverse)
done

lemma Select1_InitData [simp]:
  "Select1 (LiftInitData [V0 0, V1 0]) = 0"
apply (unfold LiftInitData_def Select1_def DataPart_def DataValue_def)
apply (simp add: Abs_data_inverse)
done

lemma HAInitValue1_CarAudioSystem:
  "CarAudioSystem |=H= Atom (VAL (\<lambda> d. (Select0 d) = 0))"
apply (simp add: ValueCarAudioSystem)
done

lemma HAInitValue2_CarAudioSystem:
  "CarAudioSystem |=H= Atom (VAL (\<lambda> d. (Select1 d) = 0))"
apply (simp add: ValueCarAudioSystem)
done

lemma HAInitValue_DSpace_CarAudioSystem [simp]:
  "Data.DataSpace (LiftInitData [V0 0, V1 0]) = DSpace"
apply (unfold LiftInitData_def Data.DataSpace_def)
apply (simp add: Abs_data_inverse)
done

lemma check_InitStatus [simp]:
  "(CarAudioSystem, InitConf CarAudioSystem, {},LiftInitData [V0 0, V1 0]) \<in> status"
apply (unfold status_def Status_def)
apply (simp add: ValueCarAudioSystem)
done

lemma InitData_InitStatus [simp]:
  "Value (InitStatus CarAudioSystem) = LiftInitData [V0 0, V1 0]"
apply (simp add: ValueCarAudioSystem)
done

lemma Events_InitStatus [simp]:
  "Events (InitStatus CarAudioSystem) = {}"
apply (unfold InitStatus_def Events_def)
apply (simp add: Abs_status_inverse)
done

lemma Conf_InitStatus [simp]:
  "Conf (InitStatus CarAudioSystem) = InitConf CarAudioSystem"
apply (unfold InitStatus_def Conf_def)
apply (simp add: Abs_status_inverse)
done

lemma CompFunCarAudioSystem_the:
  "the (CompFun CarAudioSystem ''On'') =  {CDMode_CTRL,TunerMode_CTRL}"
apply (unfold CarAudioSystem_def)
apply (subst AddSA_CompFun_the)
prefer 3
apply (subst AddSA_CompFun_the)
prefer 3
apply (subst AddSA_CompFun_the2)
apply (wellformed CarAudioSystemthms_5)+
done

lemma CompFunCarAudioSystem_the2:
  "the (CompFun CarAudioSystem ''CarAudioSystem'') =  {AudioPlayer_CTRL, CDPlayer_CTRL}"
apply (unfold CarAudioSystem_def)
apply (subst AddSA_CompFun_the3)
prefer 5
apply (subst AddSA_CompFun_the3)
prefer 5
apply (subst AddSA_CompFun_the)
prefer 3
apply (subst AddSA_CompFun_the)
prefer 3
apply (subst PseudoHA_CompFun_the)
apply (wellformed CarAudioSystemthms_5)+
done

lemma CompFunCarAudioSystem_the3:
  "the (CompFun CarAudioSystem ''Off'') =  {}"
apply (unfold CarAudioSystem_def)
apply (subst AddSA_CompFun_the3)
prefer 5
apply (subst AddSA_CompFun_the3)
prefer 5
apply (subst AddSA_CompFun_the2)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma CompFunCarAudioSystem_ran:
  "ran (CompFun CarAudioSystem) = ?X"
apply (unfold CarAudioSystem_def)
apply (rule AddSA_CompFun_ran3_IFF)
prefer 6
apply (subst AddSA_CompFun_PseudoHA_ran2)
prefer 4
apply (simp add: insert_commute)
apply (wellformed CarAudioSystemthms_5)+
done

lemma Root_CTRL_CDPlayer_CTRL_noteq [simp]:
  "Root_CTRL \<noteq> CDPlayer_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma Root_CTRL_TunerMode_CTRL_noteq [simp]:
  "Root_CTRL \<noteq> TunerMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma Root_CTRL_CDMode_CTRL_noteq [simp]:
  "Root_CTRL \<noteq> CDMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma CDPlayer_CTRL_AudioPlayer_CTRL_noteq [simp]:
  "CDPlayer_CTRL \<noteq> AudioPlayer_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma CDPlayer_CTRL_TunerMode_CTRL_noteq [simp]:
  "CDPlayer_CTRL \<noteq> TunerMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma CDPlayer_CTRL_CDMode_CTRL_noteq [simp]:
  "CDPlayer_CTRL \<noteq> CDMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma AudioPlayer_CTRL_TunerMode_CTRL_noteq [simp]:
  "AudioPlayer_CTRL \<noteq>  TunerMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma AudioPlayer_CTRL_CDMode_CTRL_noteq [simp]:
  "AudioPlayer_CTRL \<noteq> CDMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

lemma TunerMode_CTRL_CDMode_CTRL_noteq [simp]:
  "TunerMode_CTRL \<noteq>  CDMode_CTRL"
apply (rule SA_States_disjunct)
apply (wellformed CarAudioSystemthms_5)+
done

schematic_lemma Chi_CarAudioSystem:
  "Chi CarAudioSystem ''CarAudioSystem'' = ?X"
apply (unfold Chi_def)
apply (rule trans)
apply (simp add: SAsCarAudioSystem StatesCarAudioSystem restrict_def CompFunCarAudioSystem_the2)
apply (rule trans)
apply (simp add: not_sym)
apply (simp add: CarAudioSystemStates insert_or)
done

schematic_lemma Chi_CarAudioSystem_On:
  "Chi CarAudioSystem ''On'' = ?X"
apply (unfold Chi_def)
apply (rule trans)
apply (simp add: SAsCarAudioSystem StatesCarAudioSystem restrict_def CompFunCarAudioSystem_the)
apply (rule trans)
apply (simp add: not_sym)
apply (simp add: CarAudioSystemStates insert_or)
done

schematic_lemma Chi_CarAudioSystem_Off:
  "Chi CarAudioSystem ''Off'' = ?X"
apply (unfold Chi_def)
apply (simp add: SAsCarAudioSystem StatesCarAudioSystem restrict_def CompFunCarAudioSystem_the3)
done

schematic_lemma InitConf_CarAudioSystem:
  "InitConf CarAudioSystem = ?X"
apply (unfold CarAudioSystem_def)
apply (rule AddSA_InitConf_IFF)+
apply simp
apply (wellformed CarAudioSystemthms_5)
apply fast
apply (wellformed CarAudioSystemthms_5)
apply simp
apply (simp add: CarAudioSystemthms_5)
apply (wellformed CarAudioSystemthms_5)
apply fast
apply (wellformed CarAudioSystemthms_5)
apply fast
apply simp
apply (wellformed CarAudioSystemthms_5)
apply fast
apply (wellformed CarAudioSystemthms_5)
apply fast
apply simp
apply (wellformed CarAudioSystemthms_5)
apply force
apply (wellformed CarAudioSystemthms_5)
apply fast
apply (simp add: CarAudioSystemthms_5)
done

lemma Initial_State_CarAudioSystem:
  "CarAudioSystem |=H= Atom (IN ''Off'')"
apply (simp add: InitConf_CarAudioSystem )
done

end


header {* Examples *}
theory Example1
imports
  "../Numerics/Euler_Affine"
  "../Numerics/Optimize_Float"
begin

subsection {* Example 1 *}
text {* \label{sec:example1} *}
approximate_affine e1 "\<lambda>(t::real, y::real). (1::real, y*y + - t)"

lemma e1_fderiv: "((\<lambda>(t::real, y::real). (1::real, y * y + - t)) has_derivative (\<lambda>(a, b) (c, d). (0, 2 * (b * d) + - c)) x) (at x within X)"
  by (auto intro!: derivative_eq_intros simp: split_beta)

approximate_affine e1_d "\<lambda>(a::real, b::real) (c::real, d::real). (0::real, 2 * (b * d) + - c)"

interpretation e1!: aform_approximate_ivp
  "uncurry_options e1"
  "uncurry_options e1_d"
  "\<lambda>(t::real, y::real). (1::real, y*y + - t)"
  "\<lambda>(a::real, b::real) (c::real, d::real). (0::real, 2 * (b * d) + - c)"
  apply unfold_locales
  apply (rule e1[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (rule e1_fderiv)
  apply (rule e1_d[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (auto intro!: continuous_intros simp: split_beta')
  done

definition "e1_optns = default_optns
    \<lparr> precision := 30,
      tolerance := FloatR 1 (- 4),
      stepsize  := FloatR 1 (- 5),
      result_fun := ivls_result 23 4,
      printing_fun := (\<lambda>_ _ _. ())\<rparr>"

definition "e1test = (\<lambda>_::unit. euler_series_result (uncurry_options e1) (uncurry_options e1_d) e1_optns 0 (aform_of_point (Floatreal 0, FloatR 23 (- 5))) (2 ^ 7))"

lemma e1test_result: "e1test () =
  Some (FloatR 128 (- 5),
       [(FloatR 124 (- 5), (FloatR 248 (- 6), FloatR (- 8064333) (- 22)), (FloatR 256 (- 6), FloatR (- 7870071) (- 22)),
         FloatR 128 (- 5), (FloatR 128 (- 5), FloatR (- 8062606) (- 22)), FloatR 128 (- 5), FloatR (- 8045597) (- 22)),
        (FloatR 120 (- 5), (FloatR 240 (- 6), FloatR (- 7895426) (- 22)), (FloatR 248 (- 6), FloatR (- 7675653) (- 22)),
         FloatR 124 (- 5), (FloatR 124 (- 5), FloatR (- 7892990) (- 22)), FloatR 124 (- 5), FloatR (- 7872198) (- 22)),
        (FloatR 116 (- 5), (FloatR 232 (- 6), FloatR (- 7709016) (- 22)), (FloatR 240 (- 6), FloatR (- 7451009) (- 22)),
         FloatR 120 (- 5), (FloatR 120 (- 5), FloatR (- 7705284) (- 22)), FloatR 120 (- 5), FloatR (- 7678377) (- 22)),
        (FloatR 112 (- 5), (FloatR 224 (- 6), FloatR (- 7496651) (- 22)), (FloatR 232 (- 6), FloatR (- 7184402) (- 22)),
         FloatR 116 (- 5), (FloatR 116 (- 5), FloatR (- 7491763) (- 22)), FloatR 116 (- 5), FloatR (- 7454659) (- 22)),
        (FloatR 108 (- 5), (FloatR 216 (- 6), FloatR (- 7246635) (- 22)), (FloatR 224 (- 6), FloatR (- 6856697) (- 22)),
         FloatR 112 (- 5), (FloatR 112 (- 5), FloatR (- 7239665) (- 22)), FloatR 112 (- 5), FloatR (- 7189246) (- 22)),
        (FloatR 104 (- 5), (FloatR 208 (- 6), FloatR (- 6943768) (- 22)), (FloatR 216 (- 6), FloatR (- 6447931) (- 22)),
         FloatR 108 (- 5), (FloatR 108 (- 5), FloatR (- 6934005) (- 22)), FloatR 108 (- 5), FloatR (- 6863200) (- 22)),
        (FloatR 100 (- 5), (FloatR 200 (- 6), FloatR (- 6561315) (- 22)), (FloatR 208 (- 6), FloatR (- 5930812) (- 22)),
         FloatR 104 (- 5), (FloatR 104 (- 5), FloatR (- 6550420) (- 22)), FloatR 104 (- 5), FloatR (- 6456240) (- 22)),
        (FloatR 96 (- 5), (FloatR 192 (- 6), FloatR (- 6076628) (- 22)), (FloatR 200 (- 6), FloatR (- 5272536) (- 22)),
         FloatR 100 (- 5), (FloatR 100 (- 5), FloatR (- 6061774) (- 22)), FloatR 100 (- 5), FloatR (- 5940909) (- 22)),
        (FloatR 92 (- 5), (FloatR 184 (- 6), FloatR (- 5458805) (- 22)), (FloatR 192 (- 6), FloatR (- 4448579) (- 22)),
         FloatR 96 (- 5), (FloatR 96 (- 5), FloatR (- 5441674) (- 22)), FloatR 96 (- 5), FloatR (- 5284333) (- 22)),
        (FloatR 88 (- 5), (FloatR 176 (- 6), FloatR (- 4683021) (- 22)), (FloatR 184 (- 6), FloatR (- 6905460) (- 23)),
         FloatR 92 (- 5), (FloatR 92 (- 5), FloatR (- 4663998) (- 22)), FloatR 92 (- 5), FloatR (- 4461311) (- 22)),
        (FloatR 84 (- 5), (FloatR 168 (- 6), FloatR (- 7460667) (- 23)), (FloatR 176 (- 6), FloatR (- 4608469) (- 23)),
         FloatR 88 (- 5), (FloatR 88 (- 5), FloatR (- 7426779) (- 23)), FloatR 88 (- 5), FloatR (- 6929684) (- 23)),
        (FloatR 80 (- 5), (FloatR 160 (- 6), FloatR (- 5227426) (- 23)), (FloatR 168 (- 6), FloatR (- 4245644) (- 24)),
         FloatR 84 (- 5), (FloatR 84 (- 5), FloatR (- 5204767) (- 23)), FloatR 84 (- 5), FloatR (- 4627778) (- 23)),
        (FloatR 76 (- 5), (FloatR 152 (- 6), FloatR (- 5513954) (- 24)), (FloatR 160 (- 6), FloatR 6302602 (- 27)),
         FloatR 80 (- 5), (FloatR 80 (- 5), FloatR (- 5498016) (- 24)), FloatR 80 (- 5), FloatR (- 4265280) (- 24)),
        (FloatR 72 (- 5), (FloatR 144 (- 6), FloatR (- 7113030) (- 28)), (FloatR 152 (- 6), FloatR 5539800 (- 24)),
         FloatR 76 (- 5), (FloatR 76 (- 5), FloatR (- 7113030) (- 28)), FloatR 76 (- 5), FloatR 6293815 (- 27)),
        (FloatR 68 (- 5), (FloatR 136 (- 6), FloatR 4380170 (- 24)), (FloatR 144 (- 6), FloatR 4837389 (- 23)),
         FloatR 72 (- 5), (FloatR 72 (- 5), FloatR 4380170 (- 24)), FloatR 72 (- 5), FloatR 5528588 (- 24)),
        (FloatR 64 (- 5), (FloatR 128 (- 6), FloatR 4324399 (- 23)), (FloatR 136 (- 6), FloatR 6511166 (- 23)),
         FloatR 68 (- 5), (FloatR 68 (- 5), FloatR 4324399 (- 23)), FloatR 68 (- 5), FloatR 4828558 (- 23)),
        (FloatR 60 (- 5), (FloatR 120 (- 6), FloatR 6078820 (- 23)), (FloatR 128 (- 6), FloatR 7774658 (- 23)),
         FloatR 64 (- 5), (FloatR 64 (- 5), FloatR 6078820 (- 23)), FloatR 64 (- 5), FloatR 6501105 (- 23)),
        (FloatR 56 (- 5), (FloatR 112 (- 6), FloatR 7424189 (- 23)), (FloatR 120 (- 6), FloatR 4330559 (- 22)),
         FloatR 60 (- 5), (FloatR 60 (- 5), FloatR 7424189 (- 23)), FloatR 60 (- 5), FloatR 7764910 (- 23)),
        (FloatR 52 (- 5), (FloatR 104 (- 6), FloatR 8387227 (- 23)), (FloatR 112 (- 6), FloatR 4615550 (- 22)),
         FloatR 56 (- 5), (FloatR 56 (- 5), FloatR 8387227 (- 23)), FloatR 56 (- 5), FloatR 4326315 (- 22)),
        (FloatR 48 (- 5), (FloatR 96 (- 6), FloatR 4511257 (- 22)), (FloatR 104 (- 6), FloatR 4774909 (- 22)),
         FloatR 52 (- 5), (FloatR 52 (- 5), FloatR 4511257 (- 22)), FloatR 52 (- 5), FloatR 4612104 (- 22)),
        (FloatR 44 (- 5), (FloatR 88 (- 6), FloatR 4696759 (- 22)), (FloatR 96 (- 6), FloatR 4837869 (- 22)),
         FloatR 48 (- 5), (FloatR 48 (- 5), FloatR 4696759 (- 22)), FloatR 48 (- 5), FloatR 4772236 (- 22)),
        (FloatR 40 (- 5), (FloatR 80 (- 6), FloatR 4779807 (- 22)), (FloatR 176 (- 7), FloatR 4841539 (- 22)),
         FloatR 44 (- 5), (FloatR 44 (- 5), FloatR 4779807 (- 22)), FloatR 44 (- 5), FloatR 4835855 (- 22)),
        (FloatR 36 (- 5), (FloatR 72 (- 6), FloatR 4729537 (- 22)), (FloatR 80 (- 6), FloatR 4828174 (- 22)),
         FloatR 40 (- 5), (FloatR 40 (- 5), FloatR 4785154 (- 22)), FloatR 40 (- 5), FloatR 4826631 (- 22)),
        (FloatR 32 (- 5), (FloatR 64 (- 6), FloatR 4633037 (- 22)), (FloatR 72 (- 6), FloatR 4763779 (- 22)),
         FloatR 36 (- 5), (FloatR 36 (- 5), FloatR 4732129 (- 22)), FloatR 36 (- 5), FloatR 4762648 (- 22)),
        (FloatR 28 (- 5), (FloatR 56 (- 6), FloatR 4502491 (- 22)), (FloatR 64 (- 6), FloatR 4658144 (- 22)),
         FloatR 32 (- 5), (FloatR 32 (- 5), FloatR 4635000 (- 22)), FloatR 32 (- 5), FloatR 4657307 (- 22)),
        (FloatR 24 (- 5), (FloatR 48 (- 6), FloatR 4345109 (- 22)), (FloatR 56 (- 6), FloatR 4520801 (- 22)),
         FloatR 28 (- 5), (FloatR 28 (- 5), FloatR 4503999 (- 22)), FloatR 28 (- 5), FloatR 4520164 (- 22)),
        (FloatR 20 (- 5), (FloatR 40 (- 6), FloatR 8331605 (- 23)), (FloatR 48 (- 6), FloatR 4358367 (- 22)),
         FloatR 24 (- 5), (FloatR 24 (- 5), FloatR 4346293 (- 22)), FloatR 24 (- 5), FloatR 4357864 (- 22)),
        (FloatR 16 (- 5), (FloatR 32 (- 6), FloatR 7935559 (- 23)), (FloatR 40 (- 6), FloatR 8350607 (- 23)),
         FloatR 20 (- 5), (FloatR 20 (- 5), FloatR 8333519 (- 23)), FloatR 20 (- 5), FloatR 8349765 (- 23)),
        (FloatR 12 (- 5), (FloatR 24 (- 6), FloatR 7505967 (- 23)), (FloatR 32 (- 6), FloatR 7948966 (- 23)),
         FloatR 16 (- 5), (FloatR 16 (- 5), FloatR 7937165 (- 23)), FloatR 16 (- 5), FloatR 7948216 (- 23)),
        (FloatR 8 (- 5), (FloatR 16 (- 6), FloatR 7044785 (- 23)), (FloatR 24 (- 6), FloatR 7515201 (- 23)),
         FloatR 12 (- 5), (FloatR 12 (- 5), FloatR 7507373 (- 23)), FloatR 12 (- 5), FloatR 7514487 (- 23)),
        (FloatR 4 (- 5), (FloatR 8 (- 6), FloatR 6552439 (- 23)), (FloatR 16 (- 6), FloatR 7050907 (- 23)),
         FloatR 8 (- 5), (FloatR 8 (- 5), FloatR 7046074 (- 23)), FloatR 8 (- 5), FloatR 7050182 (- 23)),
        (FloatR 0 0, (FloatR 0 (- 6), FloatR 6028069 (- 23)), (FloatR 8 (- 6), FloatR 6556249 (- 23)), FloatR 4 (- 5),
         (FloatR 4 (- 5), FloatR 6553677 (- 23)), FloatR 4 (- 5), FloatR 6555475 (- 23))])"
  by eval

end


theory State_Networks_Impl
  imports TA_Impl.Normalized_Zone_Semantics_Impl State_Networks
begin

(* XXX Move *)
lemma finite_lists_length_eq:
  "finite {s. length s = r \<and> set s \<subseteq> S}" if "finite S"
  by (rule finite_lists_length_le[OF that, THEN finite_subset[rotated], where n1 = r]) auto

 (* XXX Move *)
lemma finite_lists_boundedI:
  assumes "\<forall> i < r. finite (S i)"
    shows "finite {s. length s = r \<and> (\<forall>i<r. s ! i \<in> S i)}" (is "finite ?R")
proof -
  let ?S = "\<Union> {S i | i. i < r}"
  have "?R \<subseteq> {s. length s = r \<and> set s \<subseteq> ?S}"
    by (auto dest!: aux)
  moreover have "finite \<dots>" by (rule finite_lists_length_eq) (use assms in auto)
  ultimately show ?thesis by (rule finite_subset)
qed

abbreviation "repeat x n \<equiv> map (\<lambda> _. x) [0..<n]"

subsection \<open>Pre-compiled networks with states and clocks as natural numbers\<close>
locale State_Network_Reachability_Problem_precompiled_defs =
  fixes p :: nat \<comment> \<open>Number of processes\<close>
    and m :: nat \<comment> \<open>Number of clocks\<close>
    and k :: "nat list" \<comment> \<open>Clock ceiling. Maximal constant appearing in automaton for each state\<close>
    and inv :: "(nat, int) cconstraint list list" \<comment> \<open>Clock invariants on states per process\<close>
    and pred :: "('st \<Rightarrow> bool) list list" \<comment> \<open>Clock invariants on states per process\<close>
    and trans ::
    "((nat, int) cconstraint * ('st \<Rightarrow> bool) * nat act * nat list * ('st \<Rightarrow> 'st) * nat) list list list"
    \<comment> \<open>Transitions between states per process\<close>
    and final :: "nat list list" \<comment> \<open>Final states per process. Initial location is 0\<close>
begin
  definition "clkp_set' \<equiv> \<Union>
    (collect_clock_pairs ` set (concat inv)
    \<union> (\<lambda> (g, _). collect_clock_pairs g) ` set (concat (concat trans)))"
  definition clk_set'_def: "clk_set' =
    (fst ` clkp_set' \<union> \<Union> ((\<lambda> (_, _, _, r, _). set r) ` set (concat (concat trans))))"

  text \<open>Definition of the corresponding network\<close>
  definition "make_trans \<equiv> \<lambda> (g, c, a, r, m, l'). (g, (a, (c, m)), r, l')"
  definition "I i l \<equiv> if l < length (inv ! i) then inv ! i ! l else []"
  definition "T i \<equiv>
    {(l, make_trans (trans ! i ! l ! j)) | l j. l < length (trans ! i) \<and> j < length (trans ! i ! l)}"
  definition "P \<equiv> map (\<lambda> P l. P ! l) pred"

  definition N :: "(nat, nat, int, nat, 'st) snta" where
    "N \<equiv> (map (\<lambda> i. (T i, I i)) [0..<p], P)"
  definition "init \<equiv> repeat (0::nat) p"
  definition "F s \<equiv> \<exists> i < length s. s ! i \<in> set (final ! i)"
  definition "k_fun \<equiv> \<lambda> i. if i \<le> m then k ! i else 0"

  sublocale product: Prod_TA_Defs N .

abbreviation "A \<equiv> product.prod_ta"

term state_set
end

  lemma snd_comp[simp]:
    "snd o (\<lambda> i. (f i, g i)) = g"
  by auto

locale State_Network_Reachability_Problem_precompiled_raw =
  State_Network_Reachability_Problem_precompiled_defs +
  assumes process_length: "length inv = p" "length trans = p" "length pred = p"
    and lengths:
    "\<forall> i < p. length (pred ! i) = length (trans ! i) \<and> length (inv ! i) = length (trans ! i)"
    and state_set: "\<forall> T \<in> set trans. \<forall> xs \<in> set T. \<forall> (_, _, _, _, _, l) \<in> set xs. l < length T"
    and k_length: "length k = m + 1" \<comment> \<open>Zero entry is just a dummy for the zero clock\<close>
    (* XXX Make this an abbreviation? *)
  assumes k_ceiling:
    (* "\<forall> c \<in> {1..m}. k ! c = Max ({d. (c, d) \<in> clkp_set'} \<union> {0})" *)
    "\<forall> (c, d) \<in> clkp_set'. k ! c \<ge> d"
    "k ! 0 = 0"
  assumes consts_nats: "snd ` clkp_set' \<subseteq> \<nat>"
  assumes clock_set: "clk_set' = {1..m}"
    and p_gt_0: "p > 0"
    and m_gt_0: "m > 0"
    (* XXX Can get rid of these two? *)
    and processes_have_trans: "\<forall> i < p. trans ! i \<noteq> []" \<comment> \<open>Necessary for refinement\<close>
    and start_has_trans: "\<forall> q < p. trans ! q ! 0 \<noteq> []" \<comment> \<open>Necessary for refinement\<close>

locale State_Network_Reachability_Problem_precompiled =
  State_Network_Reachability_Problem_precompiled_raw +
  assumes discrete_state_finite: "\<forall> i < p. \<forall> l < length (trans ! i). finite {s. (pred ! i ! l) s}"
begin

  lemma consts_nats':
    "\<forall> I \<in> set inv. \<forall> cc \<in> set I. \<forall> (c, d) \<in> collect_clock_pairs cc. d \<in> \<nat>"
    "\<forall> T \<in> set trans. \<forall> xs \<in> set T. \<forall> (g, _) \<in> set xs. \<forall> (c, d) \<in> collect_clock_pairs g. d \<in> \<nat>"
    using consts_nats unfolding clkp_set'_def by fastforce+

  lemma clkp_set_simp_1:
    "\<Union> (collect_clock_pairs ` set (concat inv)) = collect_clki (inv_of A)"
    apply (simp add:
        product.prod_ta_def inv_of_def product.collect_clki_prod_invariant
        product.collect_clki_product_invariant
        )
    unfolding inv_of_def collect_clki_alt_def I_def[abs_def] N_def I_def
    using process_length(1)
    apply (simp add: image_Union inv_of_def)
    apply safe
     apply (fastforce dest!: aux)
    by (fastforce dest!: nth_mem)

  (* XXX Unused *)
lemma processes_have_trans_alt:
  "\<forall> i < p. length (trans ! i) > 0"
  using processes_have_trans by auto

  lemma init_states:
    "init \<in> Product_TA_Defs.states (fst N)"
    unfolding Product_TA_Defs.states_def
    unfolding N_def trans_of_def T_def init_def using processes_have_trans p_gt_0 start_has_trans
    by force

  lemma states_not_empty:
    "Product_TA_Defs.states (fst N) \<noteq> {}"
    using init_states by blast

  lemma length_prod_T [simp]: "length product.T = p"
    unfolding N_def by auto

  lemma length_N [simp]: "length (fst N) = p"
    unfolding N_def by auto

  lemma length_P [simp]: "length P = p"
    unfolding N_def P_def using process_length(3) by auto

(*
  lemma trans_length_simp:
    assumes "xs \<in> set trans"
    shows "n = length xs"
    using assms trans_length by auto
*)

  lemma [simp]:
    "product.T' = product.product_trans"
    unfolding product.product_ta_def trans_of_def by simp

  lemma clk_set_simp_2:
    "\<Union> ((\<lambda> (g, _, _, r, _). set r) ` set (concat (concat trans))) \<supseteq> collect_clkvt (trans_of A)"
    apply (simp add: product.product_ta_def trans_of_def)
    apply (rule subset_trans)
     apply (rule product.collect_clkvt_prod_trans_subs)
    apply simp
    apply (rule subset_trans)
     apply (rule product.collect_clkvt_product_trans_subs)
    unfolding collect_clkvt_alt_def trans_of_def N_def T_def make_trans_def
    using process_length(2)
    by (fastforce dest!: nth_mem elim: bexI[rotated]) (* XXX Magic *)

  lemma clkp_set_simp_3:
    "\<Union> ((\<lambda> (g, _). collect_clock_pairs g) ` set (concat (concat trans))) \<supseteq> collect_clkt (trans_of A)"
    apply (simp add: product.product_ta_def trans_of_def)
    apply (rule subset_trans)
     apply (rule product.collect_clkt_prod_trans_subs)
    apply simp
    apply (rule subset_trans)
     apply (rule product.collect_clkt_product_trans_subs)
    unfolding collect_clkt_alt_def trans_of_def N_def T_def make_trans_def
    using process_length(2)
    by (fastforce dest!: nth_mem elim: bexI[rotated]) (* XXX Magic *)

  lemma clkp_set'_subs:
    "clkp_set A \<subseteq> clkp_set'"
    using clkp_set_simp_1 clkp_set_simp_3 by (fastforce simp add: clkp_set'_def clkp_set_def)

  lemma clk_set'_subs:
    "clk_set A \<subseteq> clk_set'"
    using clkp_set'_subs clk_set_simp_2 by (auto simp: clk_set'_def)

      (* XXX Interesting for finiteness *)
      (* XXX Move *)
  lemma Collect_fold_pair:
    "{f a b | a b. P a b} = (\<lambda> (a, b). f a b) ` {(a, b). P a b}" for P
    by auto

  lemma [simp]:
    "product.p = p"
    unfolding product.p_def by simp

      (* XXX Interesting case of proving finiteness *)
  lemma finite_T[intro, simp]:
    "finite (trans_of A)"
    unfolding product.prod_ta_def trans_of_def
  proof (simp, rule product.finite_prod_trans, goal_cases)
    case 1
    have *: "l < length (trans ! q)" if "l \<in> state_set (trans_of (product.N ! q))" "q < p" for l q
      using that state_set
      unfolding trans_of_def apply simp
      apply (erule disjE)
      unfolding N_def
       apply simp
      unfolding T_def
       apply force
      unfolding make_trans_def
      apply clarsimp
      using process_length(2)
      apply (fastforce dest!: nth_mem split: prod.split_asm)
      done
    with process_length(3) discrete_state_finite show ?case by simp (auto simp: N_def P_def)
  next
    case 2
    show ?case
    proof
      fix A assume A: "A \<in> set product.N"
      have
        "{(l, j). l < length (trans ! i) \<and> j < length (trans ! i ! l)}
        = \<Union> ((\<lambda> l. {(l, j) | j. j < length (trans ! i ! l)}) ` {l. l < length (trans ! i)})" for i
        by auto
      then show "finite (trans_of A)" using A unfolding N_def T_def trans_of_def
        by (fastforce simp: Collect_fold_pair)
    qed
  next
    case 3
    then show ?case unfolding product.p_def unfolding N_def using p_gt_0 by simp
  qed

    (* XXX *)
  lemma
    "clk_set' \<noteq> {}"
    using clock_set m_gt_0 by auto

  lemma clk_set:
    "clk_set A \<subseteq> {1..m}"
    using clock_set m_gt_0 clk_set'_subs by auto

  lemma
    "\<forall>(_, d)\<in>clkp_set A. d \<in> \<int>"
    unfolding Ints_def by auto

  lemma clkp_set_consts_nat:
    "\<forall>(_, d)\<in>clkp_set A. d \<in> \<nat>"
    using clkp_set'_subs consts_nats' unfolding clkp_set'_def by force

  lemma finite_range_I':
    "finite (range product.I')"
    apply (rule product.finite_invariant_of_product)
    unfolding N_def inv_of_def I_def by (auto intro: finite_subset[where B = "{[]}"])

  lemma finite_range_inv_of_A[intro, simp]:
    "finite (range (inv_of A))"
  proof -
    have "range (inv_of A) \<subseteq> range (product.I')" by (auto simp: product.inv_of_simp)
    then show ?thesis by (rule finite_subset) (rule finite_range_I')
  qed

  lemma finite_clkp_set_A[intro, simp]:
    "finite (clkp_set A)"
    unfolding clkp_set_def collect_clki_alt_def collect_clkt_alt_def by fast

  lemma [intro, simp]:
    "k_fun 0 = 0"
    unfolding k_fun_def using k_ceiling by simp

  lemma [intro, simp]:
    "k_fun i = 0" if "i > m"
    unfolding k_fun_def using that by simp

  lemma clkp_set'_bounds:
    "a \<in> {Suc 0..m}" if "(a, b) \<in> clkp_set'"
    using that clock_set unfolding clk_set'_def by auto

  lemma [intro]:
    "b \<le> int (k_fun a)" if "(a, b) \<in> clkp_set A"
    using that k_ceiling clkp_set'_subs k_length clkp_set'_bounds unfolding k_fun_def by force

end

locale State_Network_Reachability_Problem_precompiled_start_state =
  State_Network_Reachability_Problem_precompiled _ _ _ _ pred
  for pred :: "('st \<Rightarrow> bool) list list" +
  fixes s\<^sub>0 :: "'st"
  assumes start_pred: "(\<forall> i < p. (pred ! i ! 0) s\<^sub>0)"
begin

  sublocale Reachability_Problem A "(init, s\<^sub>0)" "PR_CONST (\<lambda> (l, s). F l)" m k_fun
    using clkp_set_consts_nat clk_set m_gt_0 by - (standard; blast)

  lemma [simp]:
    "fst ` (\<lambda>(l, g, a, r, l'). (l, map conv_ac g, a, r, l')) ` S = fst ` S"
    by force

  lemma [simp]:
    "(snd \<circ> snd \<circ> snd \<circ> snd) ` (\<lambda>(l, g, a, r, l'). (l, map conv_ac g, a, r, l')) ` S
    = (snd \<circ> snd \<circ> snd \<circ> snd) ` S"
    by force

  lemma map_trans_of:
    "map trans_of (map conv_A (fst N)) = map ((`) conv_t) (map trans_of (fst N))"
    by (simp add: trans_of_def split: prod.split)

  lemma [simp]:
    "Product_TA_Defs.states (map conv_A (fst N)) = Product_TA_Defs.states (fst N)"
    unfolding Product_TA_Defs.states_def map_trans_of by simp

  lemma [simp]:
    "product.P = P"
    unfolding N_def by simp

  lemma start_pred':
    "\<forall> i < p. (pred ! i ! (init ! i)) s\<^sub>0"
    using start_pred unfolding init_def by auto

  lemma start_pred'':
    "\<forall> i < p. ((P ! i) (init ! i)) s\<^sub>0"
    using start_pred' process_length(3) unfolding P_def by auto

  sublocale product': Prod_TA "(map conv_A (fst N), snd N)" init s\<^sub>0
    by (standard; simp add: init_states start_pred'')

end (* End of locale *)

datatype ('c, 't) constr =
  lt 'c 't |
  le 'c 't |
  eq 'c 't |
  gt 'c 't |
  ge 'c 't

type_synonym int_var_constr = "(nat, int) cconstraint"

definition check :: "int_var_constr \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> bool" where
  "check c x \<equiv> list_all (clock_val_a x) c"

datatype ('c, 't) upd =
  upd 'c 't |
  inc 'c |
  dec 'c

type_synonym int_var_upd = "(nat, int) upd"

fun modify :: "(nat, int) upd \<Rightarrow> int list \<Rightarrow> int list" where
  "modify (upd i x) s = s[i := x]"
| "modify (inc i) s = s[i := s ! i + 1]"
| "modify (dec i) s = s[i := s ! i - 1]"

locale State_Network_Reachability_Problem_precompiled_int_vars_defs =
  fixes p :: nat \<comment> \<open>Number of processes\<close>
    and m :: nat \<comment> \<open>Number of clocks\<close>
    and k :: "nat list" \<comment> \<open>Clock ceiling. Maximal constant appearing in automaton for each state\<close>
    and inv :: "(nat, int) cconstraint list list" \<comment> \<open>Clock invariants on states per process\<close>
    and pred :: "int_var_constr list list" \<comment> \<open>Clock invariants on states per process\<close>
    and trans ::
    "((nat, int) cconstraint * int_var_constr * nat act * nat list * int_var_upd * nat) list list list"
    \<comment> \<open>Transitions between states per process\<close>
    and final :: "nat list list" \<comment> \<open>Final states per process. Initial location is 0\<close>
  fixes r :: nat \<comment> \<open>Number of integer variables\<close>
    and bounds :: "(int \<times> int) list" \<comment> \<open>Lower and upper bounds for the variables\<close>
begin

  definition
    "checkb c s \<equiv>
    check c ((!) s) \<and> length s = r \<and> (\<forall> i < r. fst (bounds ! i) < s ! i \<and> s ! i < snd (bounds ! i))"

  definition pred' where "pred' = map (map checkb) pred"
  definition trans' where "trans' =
    map (map (map (\<lambda> (g, c, a, r, m, l). (g, \<lambda> s. check c ((!) s), a, r, modify m, l)))) trans"

  definition "s\<^sub>0 \<equiv> repeat 0 r"

end

locale State_Network_Reachability_Problem_precompiled_int_vars =
  State_Network_Reachability_Problem_precompiled_int_vars_defs p m k inv pred trans final r bounds +
  State_Network_Reachability_Problem_precompiled_raw p m k inv pred' trans' final
  for p m k inv pred trans final r bounds +
  fixes na :: nat \<comment> \<open>Number of action labels\<close>
  assumes init_pred: "\<forall>i<p. (pred' ! i ! 0) s\<^sub>0"
    and actions_bounded:
    "\<forall>T\<in>set trans'. \<forall>xs\<in>set T. \<forall>(_, _, a, _)\<in>set xs. pred_act (\<lambda>a. a < na) a"
begin

  lemma trans'_length:
    "length trans' = length trans"
    unfolding trans'_def by simp

  lemma trans'_lengths:
    "length (trans' ! i) = length (trans ! i)" if "i < p"
    unfolding trans'_def using process_length(2)[unfolded trans'_length] that by simp

  lemma pred'_length:
    "length pred' = length pred"
    unfolding pred'_def by simp

  lemma pred'_lengths:
    "length (pred' ! i) = length (pred ! i)" if "i < p"
    unfolding pred'_def using process_length(3)[unfolded pred'_length] that by simp

  lemma trans'_length_pred:
    "length (trans' ! i) = length (pred ! i)" if "i < p"
    using pred'_lengths lengths that by simp

  lemma
    "finite {s. length s = r \<and> (\<forall>i<r. fst (bounds ! i) < s ! i \<and> s ! i < snd (bounds ! i))}"
    using finite_lists_boundedI by force

  sublocale State_Network_Reachability_Problem_precompiled p m k inv pred' trans' final
    apply standard
    apply safe
    apply (simp only: trans'_length_pred)
    unfolding pred'_def trans'_def checkb_def
    using process_length(3)[unfolded pred'_length] finite_lists_boundedI by force (* XXX Slow *)

end

end (* End of theory *)


theory isabelle_tutorial
  imports Main Real
begin

(* Please turn off "Auto Quickcheck" and "Auto Solve Direct" in Plugins/Plugin Options/Isabelle/General/Automatically tried tools" *)

  declare [[show_sorts]]

  lemma True
    oops

  lemma False
    oops

  lemma "P \<Longrightarrow> P"
    oops

  lemma "P \<Longrightarrow> Q"
    oops

  lemma "P \<longrightarrow> P"
    oops

  lemma "P \<and> Q \<longrightarrow> P"
    oops

  lemma "P \<or> Q \<longrightarrow> P"
    oops

  lemma "P \<longrightarrow> \<not> \<not> P"
    oops

  lemma "P \<or> \<not> P"
    oops

  lemma "(P \<and> Q) \<longleftrightarrow> (Q \<and> P)"
    oops

  lemma "\<forall> x. x = x"
    oops

  lemma "\<exists> x. x = y"
    oops

  lemma "\<forall> x. x \<ge> 0" (* Correct this goal so it can be discharged *)
    oops

  (* Specify and prove the following 4 proof goals *)

  lemma "insert_here" (* "There is a boolean that is true" *)
    oops

  lemma "insert_here" (* "There exists an integer greater than 0" *)
    oops

  lemma "insert_here" (* "The does not exist a natural number less than zero *)
    oops

  lemma "insert_here" (* "Between any two real numbers there is another, distinct real number" *)
    oops

  lemma "1 + 1 = 2" (* Correct this goal so it can be discharged *)
    oops

  lemma "[1] @ [2] @ [3] = [1,2,3]"
    oops

  lemma "(xs @ ys) @ zs = xs @ (ys @ zs)"
    oops

  lemma "[1] @ [2] @ [3] = [1,2,3]" (* Prove manually using subst and append.simps *)
    oops

  lemma "\<forall> x. P x"
    oops

  lemma "x \<in> {x, y}"
    oops

  lemma "x \<in> {}" (* Correct this goal *)
    oops

  lemma "x \<notin> {y, z}" (* Can this be discharged? Why / why not? Correct if necessary. *)
    oops

  lemma "x \<in> UNIV"
    oops

  lemma "\<exists> x. x \<in> {m ..< n}" (* Can this be discharged? Why / why not? Correct if necessary. *)
    oops

  (* What's the difference between the following two goals? *)

  lemma "\<forall> y :: int. \<exists> x :: int. x > y"
    oops

  lemma "\<exists> x :: int. \<forall> y :: int. x > y"
    oops

  (* Complete this proof *)
  lemma isar1: "\<forall> x::int \<in> {m ..< n}. m \<le> x \<and> x < n"
  proof
    fix x :: int
    assume assm: "x \<in> {m ..< n}"
    from assm have f1: "m \<le> x"
      sorry
    from assm have f2: "insert_here"
      sorry
    from f1 f2 show "m \<le> x \<and> x < n"
      sorry
  oops

  (* Complete this proof *)
  lemma isar2:
    fixes x y :: real
    assumes "y > x"
    shows "\<exists> m. x < m \<and> m < y"
  proof -
    let ?m = "0"

    have f1: "x < ?m"
      sorry
    have f2: "?m < y"
      sorry

    from f1 f2 show ?thesis
      by auto
  oops

  theorem cantor: "\<exists>S. S \<notin> range (f :: 'a \<Rightarrow> 'a set)"
  proof
    let ?S = "{x. x \<notin> f x}"
    show "?S \<notin> range f"
    proof
      assume "?S \<in> range f"
      then obtain y where "?S = f y" ..
      then show False
      proof (rule equalityCE)
        assume "y \<in> f y"
        assume "y \<in> ?S"
        then have "y \<notin> f y" ..
        with \<open>y \<in> f y\<close> show ?thesis by contradiction
      next
        assume "y \<notin> ?S"
        assume "y \<notin> f y"
        then have "y \<in> ?S" ..
        with \<open>y \<notin> ?S\<close> show ?thesis by contradiction
      qed
    qed
  qed
end


theory mirror
imports Main
        "../data/Tree"
        "$HIPSTER_HOME/IsaHipster"

begin

fun mirror :: "'a Tree => 'a Tree" where
  "mirror (Leaf) = Leaf"
| "mirror (Node l y r) = Node (mirror r) y (mirror l)"

(*hipster mirror*)

lemma lemma_ta [thy_expl]: "mirror (mirror x2) = x2"
by (hipster_induct_schemes mirror.simps)

end