\<^marker>\<open>creator Bernhard Pöttinger\<close>

chapter \<open>Flow\<close>
theory Flow_Base
  imports Main Auxiliary Flow_Graph Flow_Interface
begin

paragraph \<open>Summary\<close>
text \<open>This theory established the connection between flow graphs and flow interfaces
introduced by the Flow Framework @{cite krishna20}\<close>

paragraph \<open>Major Definitions\<close>
text \<open>\<^item> @{term inf_fg}: inflow of flow graphs
\<^item> @{term outf_fg}: outflow of flow graphs
\<^item> @{term int_fg}: interface of flow graphs\<close>

paragraph \<open>Major Lemmas\<close>
text \<open>\<^item> @{term int_fg_fi_hom}: relates addition flow graphs and flow interfaces @{cite \<open>lem. 2\<close> krishna20}\<close>

section \<open>Interaction between Flow Graphs and Flow Interfaces\<close>

text \<open>We first define the interface of a flow graph @{cite \<open>p. 316\<close> krishna20}\<close>

definition inf_fg :: "('n,'m) fg \<Rightarrow> ('n \<Rightarrow> 'm::cancel_comm_monoid_add)" where
  "inf_fg h \<equiv> let i = (SOME i. flow_eq h i) in restrict (dom_fg h) 0 i"

definition outf_fg :: "('n,'m) fg \<Rightarrow> ('n \<Rightarrow> 'm::cancel_comm_monoid_add)" where
  "outf_fg h \<equiv>
    \<lambda>n. if n \<in> dom_fg h then 0 else (\<Sum>n' \<in> dom_fg h. edge_fg h n' n (flow_fg h n'))"

definition int_fg :: "('n,'m) fg \<Rightarrow> ('n,'m::cancel_comm_monoid_add) fi" where
  "int_fg h \<equiv> if h = bot then bot else fi (dom_fg h) (inf_fg h) (outf_fg h)"

lemma outf_fg_eqI:
  assumes "h1 \<noteq> bot" "h2 \<noteq> bot" "int_fg h1 = int_fg h2"
  shows "outf_fg h1 = outf_fg h2"
proof -
  have "outf_fg h1 = outf_fi (int_fg h1)"
    using assms(1) unfolding int_fg_def outf_fg_def by auto
  also have "... = outf_fi (int_fg h2)"
    using assms by simp
  also have "... = outf_fg h2"
    using assms(2) unfolding int_fg_def outf_fg_def by auto
  finally show ?thesis .
qed

lemma dom_fi_plus_fg[simp]:
  "h1 + h2 \<noteq> bot \<Longrightarrow> dom_fi (int_fg (h1 + h2)) = dom_fg h1 \<union> dom_fg h2"
  unfolding int_fg_def by simp

lemma dom_fi_int_fg[simp]:
  "dom_fi (int_fg h) = dom_fg h"
  unfolding int_fg_def by auto

lemma int_fg_bot_bot[simp]: "int_fg bot = bot"
  unfolding int_fg_def by simp

lemma int_fg_bot_bot'[simp]: "h \<noteq> bot \<Longrightarrow> int_fg h \<noteq> bot"
  unfolding int_fg_def by simp

lemma fg_fi_zero[simp]:
  "int_fg 0 = 0"
  using def_fg_zero_fg
  unfolding zero_fg_def zero_fi_def int_fg_def outf_fg_def
  by (auto intro: fi_cong)

lemma flow_eq_inf_fg:
  assumes "h \<noteq> bot"
  shows "flow_eq h (inf_fg h)"
proof -
  obtain i where "flow_eq h i" using flow_eq_exists assms by auto
  thus "flow_eq h (inf_fg h)"
    using someI[of "flow_eq h" i]
    unfolding inf_fg_def
    by (simp add: flow_eq_outside_irrelevant)
qed

lemma flow_eq_ne_bot:
  assumes "h \<noteq> bot"
  shows "\<forall>n \<in> dom_fg h. flow_fg h n = inf_fg h n + (\<Sum>n' \<in> dom_fg h. edge_fg h n' n (flow_fg h n'))"
proof -
  have "flow_eq h (inf_fg h)" using assms flow_eq_inf_fg by blast
  thus ?thesis using assms fgE' by blast
qed

lemma nbot_fg_to_flow_eq2':
  assumes "h \<noteq> bot"
  shows "flow_eq2' (dom_fg h) (edge_fg h) (flow_fg h) (inf_fg h)"
proof -
  have "flow_eq h (inf_fg h)"
    using flow_eq_inf_fg assms by blast
  then show ?thesis
    using fgE'[of h "inf_fg h"] assms
    unfolding flow_eq2'_def flow_eq'_def
    by simp
qed

lemma outf_fi_plus_fi[simp]:
  assumes "i1 + i2 \<noteq> bot"
  shows "outf_fi (i1 + i2) = (\<lambda>n. outf_fi i1 n + outf_fi i2 n) on -dom_fi (i1 + i2)"
proof -
  have "is_sum_fi i1 i2 (i1 + i2)"
    using assms plus_fi_to_is_sum_fi[of i1 i2] by simp
  thus ?thesis
    unfolding is_sum_fi_def by blast
qed

lemma outf_fi_int_fg[simp]:
  shows "outf_fi (int_fg h) = outf_fg h"
  unfolding int_fg_def outf_fg_def
  by auto

lemma outf_fg_plus_fg[simp]:
  assumes "h1 + h2 \<noteq> bot"
  shows "outf_fg (h1 + h2) = (\<lambda>n. outf_fg h1 n + outf_fg h2 n) on -dom_fg (h1 + h2)"
proof
  fix n
  assume *: "n \<in> -dom_fg (h1 + h2)"

  have "h1 \<noteq> bot" "h2 \<noteq> bot" using assms by auto
  hence disj: "h1 \<noteq> bot" "h2 \<noteq> bot" "dom_fg h1 \<inter> dom_fg h2 = {}"
    "finite (dom_fg h1)" "finite (dom_fg h2)"
    "dom_fg (h1 + h2) = dom_fg h1 \<union> dom_fg h2"
    using assms by simp_all

  have "outf_fg (h1 + h2) n = (if n \<in> dom_fg (h1 + h2) then 0 else
    (\<Sum>n' \<in> dom_fg h1 \<union> dom_fg h2. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n')))"
    unfolding outf_fg_def by (simp add: assms)
  also have "... = (\<Sum>n' \<in> dom_fg h1. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n'))
                 + (\<Sum>n' \<in> dom_fg h2. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n'))"
    using * disj sum.union_disjoint[of "dom_fg h1" "dom_fg h2"
        "\<lambda>n'. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n')"] assms
    by simp
  also have "... = (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
                 + (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
    using flow_fg_plus_fg_on1[of h1 h2] edge_fg_plus_fg_on1[of h1 h2]
      flow_fg_plus_fg_on2[of h1 h2] edge_fg_plus_fg_on2[of h1 h2] assms by simp
  finally show "outf_fg (h1 + h2) n = outf_fg h1 n + outf_fg h2 n"
    unfolding outf_fg_def using * disj
    by simp
qed

lemma flow_eq_to_sum:
  assumes A: "h1 + h2 \<noteq> bot"
  shows "inf_fg h1 = (\<lambda>n. (inf_fg (h1 + h2)) n + outf_fg h2 n) on (dom_fg h1)"
proof safe
  let ?i1 = "inf_fg h1"
  let ?o2 = "outf_fg h2"
  let ?i12 = "inf_fg (h1 + h2)"
  let ?N12 = "dom_fg (h1 + h2)"
  let ?e12 = "edge_fg (h1 + h2)"
  let ?f12 = "flow_fg (h1 + h2)"

  fix n
  assume D: "n \<in> dom_fg h1"

  have nbot: "h1 \<noteq> bot" "h2 \<noteq> bot" using A by auto
  have X: "h1 \<noteq> bot" "h2 \<noteq> bot" using A nbot by simp_all
  hence *: "int_fg h1 \<noteq> bot" "int_fg h2 \<noteq> bot" "int_fg (h1 + h2) \<noteq> bot"
    using A unfolding int_fg_def by simp_all
  have Y: "dom_fg h1 \<inter> dom_fg h2 = {}" "dom_fg h1 \<union> dom_fg h2 = ?N12"
    "finite (dom_fg h2)" "finite (dom_fg h1)"
    using A by auto

  have "?f12 n = ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))"
    using * D A flow_eq_ne_bot[of "h1 + h2"] by simp
  hence "flow_fg h1 n = ?i12 n + (\<Sum>n' \<in> dom_fg (h1 + h2). ?e12 n' n (?f12 n'))"
    using flow_fg_plus_fg_on1[of h1 h2]  \<open>n \<in> dom_fg h1\<close> A by auto
  hence "?i1 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
            = ?i12 n + (\<Sum>n' \<in> dom_fg (h1 + h2). edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n'))"
    using * flow_eq_ne_bot[of h1] \<open>n \<in> dom_fg h1\<close> nbot by auto
  hence "inf_fg h1 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
            = ?i12 n + (\<Sum>n' \<in> dom_fg h1 \<union> dom_fg h2. ?e12 n' n (?f12 n'))"
    using Y by simp
  hence "inf_fg h1 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
            = ?i12 n + (\<Sum>n' \<in> dom_fg h1. ?e12 n' n (?f12 n'))
                     + (\<Sum>n' \<in> dom_fg h2. ?e12 n' n (?f12 n'))"
    using * Y sum.union_disjoint[of "dom_fg h1" "dom_fg h2" "\<lambda>n'. ?e12 n' n (?f12 n')"]
    by (simp add: algebra_simps)
  hence "inf_fg h1 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
            = ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
                     + (\<Sum>n' \<in> dom_fg h2. ?e12 n' n (?f12 n'))"
    using flow_fg_plus_fg_on1[of h1 h2] edge_fg_plus_fg_on1[of h1 h2] \<open>n \<in> dom_fg h1\<close> A by auto
  hence "inf_fg h1 n = ?i12 n + (\<Sum>n' \<in> dom_fg h2. edge_fg (h1 + h2) n' n (?f12 n'))"
    by (metis (no_types, lifting) add.assoc add.commute add_left_cancel)
  hence "inf_fg h1 n = ?i12 n + (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
    using flow_fg_plus_fg_on2[of h1 h2] edge_fg_plus_fg_on2[of h1 h2]
      \<open>n \<in> dom_fg h1\<close> A sum.cong by (metis (no_types, lifting))
  thus "inf_fg h1 n = ?i12 n + outf_fg h2 n"
    unfolding outf_fg_def using \<open>n \<in> dom_fg h1\<close> Y by auto
qed

text \<open>The most important statement of the relation between flow graphs and flow interfaces.
@{cite \<open>lem. 2\<close> krishna20}\<close>

lemma int_fg_fi_hom: "int_fg (h1 + h2) = int_fg h1 + int_fg h2"
proof (rule fi_eqI2)
  assume "int_fg (h1 + h2) \<noteq> bot"
  hence A: "h1 + h2 \<noteq> bot" unfolding int_fg_def by auto

  let ?i1 = "inf_fg h1"
  let ?i2 = "inf_fg h2"
  let ?i12 = "inf_fg (h1 + h2)"
  let ?o1 = "outf_fg h1"
  let ?o2 = "outf_fg h2"
  let ?o12 = "outf_fg (h1 + h2)"
  let ?I12 = "int_fg (h1 + h2)"
  let ?I1 = "int_fg h1"
  let ?I2 = "int_fg h2"
  let ?N12 = "dom_fg (h1 + h2)"
  let ?e12 = "edge_fg (h1 + h2)"
  let ?f12 = "flow_fg (h1 + h2)"

  have [simp]: "h1 \<noteq> bot" "h2 \<noteq> bot" using A by auto
  have X: "h1 \<noteq> bot" "h2 \<noteq> bot" using A by simp_all
  hence *: "int_fg h1 \<noteq> bot" "int_fg h2 \<noteq> bot" "int_fg (h1 + h2) \<noteq> bot"
    using A unfolding int_fg_def by simp_all

  have Y: "dom_fg h1 \<inter> dom_fg h2 = {}" "dom_fg h1 \<union> dom_fg h2 = dom_fg (h1 + h2)"
    "finite (dom_fg h2)" "finite (dom_fg h1)"
    using A by auto

  have "?i1 = (\<lambda>n. ?i12 n + ?o2 n) on (dom_fg h1)"
    using flow_eq_to_sum[of h1 h2] A by simp
  hence X1: "inf_fi ?I1 = \<lambda>n. inf_fi ?I12 n + outf_fi ?I2 n on dom_fi ?I1"
    using A Y unfolding int_fg_def apply auto
    by (metis IntI Y(1) empty_iff)

  have "?i2 = (\<lambda>n. ?i12 n + ?o1 n) on (dom_fg h2)"
    using flow_eq_to_sum[of h2 h1] A by (simp add: algebra_simps)
  hence X2: "inf_fi ?I2 = \<lambda>n. inf_fi ?I12 n + outf_fi ?I1 n on dom_fi ?I2"
    using A Y unfolding int_fg_def apply auto
    by (metis IntI Y(1) empty_iff)

  have "?o12 = (\<lambda>n. ?o1 n + ?o2 n) on (-?N12)"
  proof
    fix n
    assume "n \<in> -?N12"
    hence "?o12 n = (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))"
      unfolding outf_fg_def using Y by simp
    also have "... = (\<Sum>n' \<in> dom_fg h1. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n'))
                   + (\<Sum>n' \<in> dom_fg h2. edge_fg (h1 + h2) n' n (flow_fg (h1 + h2) n'))"
      using * Y sum.union_disjoint[of "dom_fg h1" "dom_fg h2" "\<lambda>n'. ?e12 n' n (?f12 n')"]
      by (simp add: algebra_simps)
    also have "... = (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))
                   + (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      using flow_fg_plus_fg_on1[of h1 h2] edge_fg_plus_fg_on1[of h1 h2]
        flow_fg_plus_fg_on2[of h1 h2] edge_fg_plus_fg_on2[of h1 h2] A by simp
    finally show "?o12 n = ?o1 n + ?o2 n"
      unfolding outf_fg_def using \<open>n \<in> -dom_fg (h1 + h2)\<close> Y by auto
  qed
  hence X3: "outf_fi ?I12 = \<lambda>n. outf_fi ?I1 n + outf_fi ?I2 n on - dom_fi ?I12"
    using A unfolding int_fg_def by simp

  have "is_sum_fi (int_fg h1) (int_fg h2) (int_fg (h1 + h2))"
    unfolding is_sum_fi_def using Y A X1 X2 X3 unfolding int_fg_def by simp
  hence "int_fg h1 + int_fg h2 = int_fg (h1 + h2)"
    using is_sum_fi_to_plus_fi by blast
  thus "int_fg (h1 + h2) = int_fg h1 + int_fg h2"
    by simp
next
  assume A: "int_fg h1 + int_fg h2 \<noteq> bot"
  hence nbot[simp]: "h1 \<noteq> bot" "h2 \<noteq> bot" using A unfolding int_fg_def by auto

  let ?i1 = "inf_fi (int_fg h1)"
  let ?i2 = "inf_fi (int_fg h2)"
  let ?i12 = "inf_fi (int_fg h1 + int_fg h2)"
  let ?o1 = "outf_fi (int_fg h1)"
  let ?o2 = "outf_fi (int_fg h2)"
  let ?o12 = "outf_fi (int_fg h1 + int_fg h2)"
  let ?I12 = "int_fg (h1 + h2)"
  let ?I1 = "int_fg h1"
  let ?I2 = "int_fg h2"
  let ?e2 = "edge_fg h2"
  let ?f2 = "flow_fg h2"
  let ?e1 = "edge_fg h1"
  let ?f1 = "flow_fg h1"
  let ?N1 = "dom_fg h1"
  let ?N2 = "dom_fg h2"

  have X: "h1 \<noteq> bot" "h2 \<noteq> bot" using A by simp_all
  hence *: "int_fg h1 \<noteq> bot" "int_fg h2 \<noteq> bot" using A by auto

  have B: "is_sum_fi (int_fg h1) (int_fg h2) (int_fg h1 + int_fg h2)"
    using A by (simp add: plus_fi_to_is_sum_fi)

  have Y:  "dom_fg h1 \<inter> dom_fg h2 = {}"
    "finite (dom_fg h2)" "finite (dom_fg h1)"
    using A X dom_fi_plus_fi[of "int_fg h1" "int_fg h2"] by auto

  let ?N12 = "dom_fg h1 \<union> dom_fg h2"
  let ?e12 = "combine (dom_fg h1) (dom_fg h2) (\<lambda>_ _. 0) (edge_fg h1) (edge_fg h2)"
  let ?f12 = "combine (dom_fg h1) (dom_fg h2)        0  (flow_fg h1) (flow_fg h2)"

  have "?f12 = (\<lambda>n. ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))) on (dom_fg h1)"
  proof
    fix n
    assume "n \<in> dom_fg h1"
    hence "?i1 n = ?i12 n + ?o2 n"
      using B unfolding is_sum_fi_def by simp
    hence "?i1 n = ?i12 n + (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      using Y \<open>n \<in> dom_fg h1\<close> unfolding outf_fg_def int_fg_def by auto
    hence "?i1 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n')) =
              ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n')) +
                       (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      by (simp add: algebra_simps)
    hence "?f12 n =
              ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n')) +
                       (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      using \<open>n \<in> dom_fg h1\<close> flow_eq_ne_bot[of h1] unfolding int_fg_def by (simp add: algebra_simps)
    hence "?f12 n = ?i12 n + (\<Sum>n' \<in> dom_fg h1. ?e12 n' n (?f12 n')) +
                             (\<Sum>n' \<in> dom_fg h2. ?e12 n' n (?f12 n'))"
      using Y sum.cong[of ?N2 ?N2 "\<lambda>n'. ?e2 n' n (?f2 n')" "\<lambda>n'. ?e12 n' n (?f12 n')"]
      by fastforce
    thus "?f12 n = ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))"
      using Y sum.union_disjoint[of ?N1 ?N2 "\<lambda>n'. ?e12 n' n (?f12 n')"]
      by (simp add: algebra_simps)
  qed
  moreover have "?f12 = (\<lambda>n. ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))) on (dom_fg h2)"
  proof
    fix n
    assume "n \<in> dom_fg h2"
    hence "?i2 n = ?i12 n + ?o1 n"
      using B unfolding is_sum_fi_def by simp
    hence "?i2 n = ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n'))"
      using Y \<open>n \<in> dom_fg h2\<close> unfolding outf_fg_def int_fg_def by auto
    hence "?i2 n + (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n')) =
              ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n')) +
                       (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      by (simp add: algebra_simps)
    hence "?f12 n =
              ?i12 n + (\<Sum>n' \<in> dom_fg h1. edge_fg h1 n' n (flow_fg h1 n')) +
                       (\<Sum>n' \<in> dom_fg h2. edge_fg h2 n' n (flow_fg h2 n'))"
      using \<open>n \<in> ?N2\<close> flow_eq_ne_bot[of h2] Y unfolding int_fg_def by (auto simp: algebra_simps)
    hence "?f12 n = ?i12 n + (\<Sum>n' \<in> dom_fg h1. ?e12 n' n (?f12 n')) +
                             (\<Sum>n' \<in> dom_fg h2. ?e12 n' n (?f12 n'))"
      using Y sum.cong[of ?N2 ?N2 "\<lambda>n'. ?e2 n' n (flow_fg h2 n')" "\<lambda>n'. ?e12 n' n (?f12 n')"]
      by fastforce
    thus "?f12 n = ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))"
      using Y sum.union_disjoint[of "dom_fg h1" "dom_fg h2" "\<lambda>n'. ?e12 n' n (?f12 n')"]
      by (simp add: algebra_simps)
  qed
  ultimately have XXXX: "?f12 = (\<lambda>n. ?i12 n + (\<Sum>n' \<in> ?N12. ?e12 n' n (?f12 n'))) on (?N1 \<union> ?N2)"
    by auto
  (* we have a solution to the flow equation and obtain validity of fg _ _ _ *)
  hence XXXXX: "fg ?N12 ?e12 ?f12 \<noteq> bot" by (rule fgI, auto)
  (* we show that the fg _ _ _ we proved validity for is exactly h1 + h2 *)
  hence chain: "fg ?N12 ?e12 ?f12 = h1 + h2" unfolding plus_fg_def using Y by auto
  (* it follows that h1 + h2 \<noteq> nbot *)
  hence C': "h1 + h2 \<noteq> bot" using XXXXX by simp

  have D: "dom_fg (h1 + h2) = dom_fi (int_fg h1 + int_fg h2)" using C' A by auto

  (* we have to show equality of the inflows to h1 + h2 *)
  (* first, show that our explicit solution is a solution (was already done in XXXXX,
     but is hidden behind existential quantifier) *)
  have C: "flow_eq (h1 + h2) ?i12"
    using XXXX flow_eqI[of "dom_fg h1 \<union> dom_fg h2" ?f12 ?i12 ?e12] chain by simp
  (* second, obtain the existentially quantified inflow *)
  have "flow_eq (h1 + h2) (inf_fg (h1 + h2))" by (fact flow_eq_inf_fg[OF C'])
  (* uniqueness implies equality of both variants *)
  hence "inf_fg (h1 + h2) = ?i12 on dom_fg (h1 + h2)"
    using C flow_eq_unique unfolding int_fg_def by simp
  (* the equality we have to prove *)
  hence X1: "?i12 = inf_fi (int_fg (h1 + h2)) on dom_fi (int_fg h1 + int_fg h2)"
    using D unfolding int_fg_def by auto

  have X2: "?o12 = outf_fi (int_fg (h1 + h2)) on -dom_fi (int_fg h1 + int_fg h2)"
    using A C' unfolding int_fg_def by auto

  have X3: "int_fg (h1 + h2) \<noteq> bot" using C' unfolding int_fg_def by simp

  have X4: "dom_fi (int_fg h1 + int_fg h2) = dom_fi (int_fg (h1 + h2))"
    using C' A by auto

  show "int_fg h1 + int_fg h2 = int_fg (h1 + h2)"
    by (fact fi_eqI[OF A X3 X4 X1 X2])
qed

lemma int_fg_plus_cong:
  assumes "int_fg h1 = int_fg h1'"
  shows "int_fg (h1 + h2) = int_fg (h1' + h2)"
  unfolding int_fg_def
  apply auto
    apply (metis assms int_fg_def int_fg_fi_hom plus_fg_dom_un)
  using int_fg_fi_hom[of h1 h2] assms int_fg_fi_hom[of h1' h2, symmetric] apply simp
  by (smt int_fg_def assms dom_fi_int_fg dom_fi_plus_fg int_fg_fi_hom)

lemma outf_fg_unfold:
  assumes "h \<noteq> bot" "n \<notin> dom_fg h"
  shows "outf_fg h n = (\<Sum>n' \<in> dom_fg h. edge_fg h n' n (flow_fg h n'))"
  using assms
  unfolding outf_fg_def dom_fg_def edge_fg_def flow_fg_def
  by auto

lemma outf_fg_unfold':
  assumes "h \<noteq> bot"
  shows "outf_fg h =
    (\<lambda>n. if n \<in> dom_fg h then 0 else (\<Sum>n' \<in> dom_fg h. edge_fg h n' n (flow_fg h n')))"
  using assms
  unfolding outf_fg_def dom_fg_def edge_fg_def flow_fg_def
  by auto

lemma outf_fg_outside_plus:
  assumes "h' = h0 + h" "h' \<noteq> bot" "\<forall>n n'. edge_fg h0 n n' = (\<lambda>_. 0)"
  shows "outf_fg h' = outf_fg h on (-dom_fg h')"
proof
  fix x
  assume A: "x \<in> -dom_fg h'"

  have D: "h0 \<noteq> bot" "h \<noteq> bot"
    using plus_fg_ops_exist assms by auto

  have disj: "dom_fg h0 \<inter> dom_fg h = {}"
    using assms by simp

  show "outf_fg h' x = outf_fg h x"
    using assms A D by (simp, subst outf_fg_unfold, simp_all)
qed

lemma inf_fg_outside_0:
  "inf_fg h = (\<lambda>_. 0) on -dom_fg h"
proof (cases "h = bot")
case True
  then show ?thesis unfolding inf_fg_def by simp
next
case False
  then show ?thesis unfolding inf_fg_def by simp
qed

lemma int_fg_to_inf_fg:
  assumes "int_fg h1 = int_fg h2" "h1 \<noteq> bot"
  shows "inf_fg h1 = inf_fg h2"
proof -
  have *: "h2 \<noteq> bot" using assms by auto
  then have
    "fi (dom_fg h1) (inf_fg h1) (outf_fg h1) = fi (dom_fg h2) (inf_fg h2) (outf_fg h2)"
    using assms unfolding int_fg_def by simp
  then have "inf_fi (fi (dom_fg h1) (inf_fg h1) (outf_fg h1)) =
    inf_fi (fi (dom_fg h2) (inf_fg h2) (outf_fg h2))"
    by simp
  then have "restrict (dom_fg h1) 0 (inf_fg h1) = restrict (dom_fg h2) 0 (inf_fg h2)"
    using inf_fi_fi by simp
  moreover have *: "dom_fg h1 = dom_fg h2"
    using assms by (metis dom_fi_int_fg)
  ultimately show ?thesis
    apply (intro ext)
    apply (case_tac "x \<in> dom_fg h1")
     apply metis
    using inf_fg_outside_0[of h1] inf_fg_outside_0[of h2] * by simp
qed

lemma inf_fg_fg:
  assumes "f = (\<lambda>n. i n + (\<Sum>n' \<in> N. e n' n (f n'))) on N" "finite N"
  shows "inf_fg (fg N e f) = restrict N 0 i"
proof -
  let ?i = "SOME i. flow_eq (fg N e f) i"
  let ?h = "fg N e f"

  have *: "fg N e f \<noteq> bot"
    by (rule fgI[where i=i], simp_all add: assms)
  then have **: "flow_eq (fg N e f) i"
    using flow_eqI[of N f i e] assms by simp
  have ***: "flow_eq ?h (SOME i. flow_eq ?h i)"
    apply (rule someI_ex[of "flow_eq ?h"])
    using ** by blast
  have "i = ?i on N"
    using flow_eq_unique[OF ** ***] * by simp
  then show ?thesis
    unfolding inf_fg_def
    using * by auto
qed

lemma inf_fg_fg':
  assumes "flow_eq2' N e f i" "finite N"
  shows "inf_fg (fg N e f) = restrict N 0 i"
  using assms inf_fg_fg
  unfolding flow_eq2'_def flow_eq'_def
  by blast

lemma inf_fg_fg'':
  assumes "flow_eq (fg N e f) i" "finite N"
  shows "inf_fg (fg N e f) = restrict N 0 i"
  apply (rule inf_fg_fg)
  using fgE'[OF assms(1)] fgI2[OF assms(1) assms(2)] assms
  by auto

lemma inf_fg_int_fg:
  assumes "h \<noteq> bot"
  shows "inf_fi (int_fg h) = inf_fg h"
  using assms
  unfolding int_fg_def
  apply simp
  unfolding inf_fg_def
  by auto

lemma dom_fg_plus_fg_subs1:
  "h1 + h2 \<noteq> bot \<Longrightarrow> dom_fg h1 \<subseteq> dom_fg (h1 + h2)"
  by simp

lemma dom_fg_plus_fg_iff:
  assumes "h = h1 + h2" "h \<noteq> bot" "x \<in> dom_fg h"
  shows "x \<in> dom_fg h2 \<longleftrightarrow> x \<notin> dom_fg h1"
proof -
  have "dom_fg h1 \<inter> dom_fg h2 = {}" "dom_fg h1 \<union> dom_fg h2 = dom_fg h"
    using assms by simp_all
  then show ?thesis
    using assms by blast
qed

lemma plus_fg_not_equal:
  fixes h h1 h2 :: "('a, 'b :: cancel_comm_monoid_add) fg"
  assumes "h = h1 + h2" "h \<noteq> bot" "dom_fg h1 \<noteq> {}"
  shows "h1 \<noteq> h2"
proof (rule ccontr)
  assume "\<not> (h1 \<noteq> h2)"
  then have "dom_fg h1 = dom_fg h2" by simp
  moreover have "dom_fg h1 \<inter> dom_fg h2 = {}" using assms by auto
  ultimately show False using assms by simp
qed

paragraph \<open>Special cases of interfaces of singleton flow graphs\<close>

text \<open>@{cite \<open>lem. 2\<close> krishna19b}\<close>
lemma int_fg_singleton_fi:
  assumes "h \<noteq> bot" "n \<in> dom_fg h" "edge_fg h n n = (\<lambda>_. 0)"
  shows "int_fg (fg {n} (edge_fg h) (flow_fg h)) =
    fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n))"
proof -
  let ?h = "fg {n} (edge_fg h) (flow_fg h)"
  let ?i = "\<lambda>_. flow_fg h n"

  have feq: "flow_eq ?h ?i" by (rule flow_eqI, auto simp: assms)
  have nbot: "?h \<noteq> bot" using assms def_fg_singleton' by metis
  have "inf_fg ?h = ?i on {n}" using flow_eq_unique[OF flow_eq_inf_fg[OF nbot] feq] nbot by auto

  with assms nbot show ?thesis
    unfolding int_fg_def
    apply auto
    apply (rule fi_eqI)
    using inf_fg_fg''[OF flow_eq_inf_fg[OF nbot]] feq unfolding outf_fg_def by auto
qed

lemma int_fg_singleton:
  assumes "dom_fg h = {n}" "edge_fg h n n = (\<lambda>_. 0)"
  shows "int_fg h = fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n))" "int_fg h \<noteq> bot"
proof (rule fi_eqI)
  have [simp]: "h \<noteq> bot"
    using assms def_fg_singleton[of h n]
    by simp

  show "int_fg h \<noteq> bot" using assms def_fg_singleton unfolding int_fg_def by auto
  then show "int_fg h \<noteq> bot" .

  show "fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n)) \<noteq> bot"
    using def_fg_singleton[of h n] assms
    by auto

  show "dom_fi (int_fg h) = dom_fi (fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n)))"
    using assms by simp

  have "flow_eq h (inf_fg h)" using flow_eq_inf_fg by force
  thus "inf_fi (int_fg h) =
    inf_fi (fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n))) on dom_fi (int_fg h)"
    using assms fgE'[of h] unfolding int_fg_def by auto

  show " outf_fi (int_fg h) =
    outf_fi (fi {n} (\<lambda>_. flow_fg h n) (\<lambda>n'. edge_fg h n n' (flow_fg h n))) on -dom_fi (int_fg h)"
    unfolding outf_fg_def int_fg_def using assms by simp
qed

lemma int_fg_singleton_id:
  assumes "dom_fg h = {n}" "edge_fg h n n = id"
  shows "int_fg h = fi {n} (\<lambda>_. 0) (\<lambda>n'. edge_fg h n n' (flow_fg h n))"
proof (rule fi_eqI)
  have [simp]: "h \<noteq> bot"
    using assms def_fg_singleton_id[of h n] by simp

  let ?h = "fi {n} (\<lambda>_. 0) (\<lambda>n'. edge_fg h n n' (flow_fg h n))"

  show "int_fg h \<noteq> bot" using assms def_fg_singleton unfolding int_fg_def by auto
  show "?h \<noteq> bot" by auto
  show "dom_fi (int_fg h) = dom_fi ?h" using assms by simp
  have "flow_eq h (inf_fg h)" using flow_eq_inf_fg by force
  thus "inf_fi (int_fg h) = inf_fi ?h on dom_fi (int_fg h)"
    using assms fgE'[of h] unfolding int_fg_def by auto
  show " outf_fi (int_fg h) = outf_fi ?h on -dom_fi (int_fg h)"
    unfolding outf_fg_def int_fg_def using assms by simp
qed

end


(*  Author:     Tobias Nipkow, 2007  *)

section "DLO"

theory DLO
imports QE Complex_Main
begin

subsection "Basics"

class dlo = linorder +
assumes dense: "x < z \<Longrightarrow> \<exists>y. x < y \<and> y < z"
and no_ub: "\<exists>u. x < u" and no_lb: "\<exists>l. l < x"

instance real :: dlo
proof
  fix r s :: real
  let ?v = "(r + s) / 2"
  assume "r < s"
  hence "r < ?v \<and> ?v < s" by simp
  thus "\<exists>v. r < v \<and> v < s" ..
next
  fix r :: real
  have "r < r + 1" by arith
  thus "\<exists>s. r < s" ..
next
  fix r :: real
  have "r - 1 < r" by arith
  thus "\<exists>s. s < r" ..
qed

datatype atom = Less nat nat | Eq nat nat

fun is_Less :: "atom \<Rightarrow> bool" where
"is_Less (Less i j) = True" |
"is_Less f = False"

abbreviation "is_Eq \<equiv> Not \<circ> is_Less"

lemma is_Less_iff: "is_Less a = (\<exists>i j. a = Less i j)"
by(cases a) auto
lemma is_Eq_iff: "(\<forall>i j. a \<noteq> Less i j) = (\<exists>i j. a = Eq i j)"
by(cases a) auto
lemma not_is_Eq_iff: "(\<forall>i j. a \<noteq> Eq i j) = (\<exists>i j. a = Less i j)"
by(cases a) auto

fun neg\<^sub>d\<^sub>l\<^sub>o :: "atom \<Rightarrow> atom fm" where
"neg\<^sub>d\<^sub>l\<^sub>o (Less i j) = Or (Atom(Less j i)) (Atom(Eq i j))" |
"neg\<^sub>d\<^sub>l\<^sub>o (Eq i j) = Or (Atom(Less i j)) (Atom(Less j i))"

fun I\<^sub>d\<^sub>l\<^sub>o :: "atom \<Rightarrow> 'a::dlo list \<Rightarrow> bool" where
"I\<^sub>d\<^sub>l\<^sub>o (Eq i j) xs = (xs!i = xs!j)" |
"I\<^sub>d\<^sub>l\<^sub>o (Less i j) xs = (xs!i < xs!j)"

fun depends\<^sub>d\<^sub>l\<^sub>o :: "atom \<Rightarrow> bool" where
"depends\<^sub>d\<^sub>l\<^sub>o(Eq i j) = (i=0 | j=0)" |
"depends\<^sub>d\<^sub>l\<^sub>o(Less i j) = (i=0 | j=0)"

fun decr\<^sub>d\<^sub>l\<^sub>o :: "atom \<Rightarrow> atom" where
"decr\<^sub>d\<^sub>l\<^sub>o (Less i j) = Less (i - 1) (j - 1)" |
"decr\<^sub>d\<^sub>l\<^sub>o (Eq i j) = Eq (i - 1) (j - 1)"

(* needed for code generation *)
definition [code del]: "nnf = ATOM.nnf neg\<^sub>d\<^sub>l\<^sub>o"
definition [code del]: "qelim = ATOM.qelim depends\<^sub>d\<^sub>l\<^sub>o decr\<^sub>d\<^sub>l\<^sub>o"
definition [code del]: "lift_dnf_qe = ATOM.lift_dnf_qe neg\<^sub>d\<^sub>l\<^sub>o depends\<^sub>d\<^sub>l\<^sub>o decr\<^sub>d\<^sub>l\<^sub>o"
definition [code del]: "lift_nnf_qe = ATOM.lift_nnf_qe neg\<^sub>d\<^sub>l\<^sub>o"

hide_const nnf qelim lift_dnf_qe lift_nnf_qe

lemmas DLO_code_lemmas = nnf_def qelim_def lift_dnf_qe_def lift_nnf_qe_def

interpretation DLO:
  ATOM neg\<^sub>d\<^sub>l\<^sub>o "(\<lambda>a. True)" I\<^sub>d\<^sub>l\<^sub>o depends\<^sub>d\<^sub>l\<^sub>o decr\<^sub>d\<^sub>l\<^sub>o
apply(unfold_locales)
apply(case_tac a)
apply simp_all
apply(case_tac a)
apply (simp_all add:linorder_class.not_less_iff_gr_or_eq
                    linorder_not_less linorder_neq_iff)
apply(case_tac a)
apply(simp_all add:nth_Cons')
done

lemmas [folded DLO_code_lemmas, code] =
  DLO.nnf.simps DLO.qelim_def DLO.lift_dnf_qe.simps DLO.lift_dnf_qe.simps

setup \<open>Sign.revert_abbrev "" @{const_abbrev DLO.I}\<close>

definition lbounds where "lbounds as = [i. Less (Suc i) 0 \<leftarrow> as]"
definition ubounds where "ubounds as = [i. Less 0 (Suc i) \<leftarrow> as]"
definition ebounds where
 "ebounds as = [i. Eq (Suc i) 0 \<leftarrow> as] @ [i. Eq 0 (Suc i) \<leftarrow> as]"

lemma set_lbounds: "set(lbounds as) = {i. Less (Suc i) 0 \<in> set as}"
by(auto simp: lbounds_def split:nat.splits atom.splits)
lemma set_ubounds: "set(ubounds as) = {i. Less 0 (Suc i) \<in> set as}"
by(auto simp: ubounds_def split:nat.splits atom.splits)
lemma set_ebounds:
  "set(ebounds as) = {k. Eq (Suc k) 0 \<in> set as \<or> Eq 0 (Suc k) \<in> set as}"
by(auto simp: ebounds_def split: atom.splits nat.splits)

abbreviation "LB f xs \<equiv> {xs!i|i. Less (Suc i) 0 \<in> set(DLO.atoms\<^sub>0 f)}"
abbreviation "UB f xs \<equiv> {xs!i|i. Less 0 (Suc i) \<in> set(DLO.atoms\<^sub>0 f)}"
definition "EQ f xs = {xs!k|k.
  Eq (Suc k) 0 \<in> set(DLO.atoms\<^sub>0 f) \<or> Eq 0 (Suc k) \<in> set(DLO.atoms\<^sub>0 f)}"

lemma EQ_And[simp]: "EQ (And f g) xs = (EQ f xs \<union> EQ g xs)"
by(auto simp:EQ_def)

lemma EQ_Or[simp]: "EQ (Or f g) xs = (EQ f xs \<union> EQ g xs)"
by(auto simp:EQ_def)

lemma EQ_conv_set_ebounds:
  "x \<in> EQ f xs = (\<exists>e\<in>set(ebounds(DLO.atoms\<^sub>0 f)). x = xs!e)"
by(auto simp: EQ_def set_ebounds)

fun isubst where "isubst k 0 = k" | "isubst k (Suc i) = i"

fun asubst :: "nat \<Rightarrow> atom \<Rightarrow> atom" where
"asubst k (Less i j) = Less (isubst k i) (isubst k j)"|
"asubst k (Eq i j) = Eq (isubst k i) (isubst k j)"

abbreviation "subst \<phi> k \<equiv> map\<^sub>f\<^sub>m (asubst k) \<phi>"

lemma I_subst:
 "qfree f \<Longrightarrow> DLO.I (subst f k) xs = DLO.I f (xs!k # xs)"
apply(induct f)
apply(simp_all)
apply(rename_tac a)
apply(case_tac a)
apply(simp_all add:nth.simps split:nat.splits)
done

fun amin_inf :: "atom \<Rightarrow> atom fm" where
"amin_inf (Less _ 0) = FalseF" |
"amin_inf (Less 0 _) = TrueF" |
"amin_inf (Less (Suc i) (Suc j)) = Atom(Less i j)" |
"amin_inf (Eq 0 0) = TrueF" |
"amin_inf (Eq 0 _) = FalseF" |
"amin_inf (Eq _ 0) = FalseF" |
"amin_inf (Eq (Suc i) (Suc j)) = Atom(Eq i j)"

abbreviation min_inf :: "atom fm \<Rightarrow> atom fm" ("inf\<^sub>-") where
"inf\<^sub>- \<equiv> amap\<^sub>f\<^sub>m amin_inf"

fun aplus_inf :: "atom \<Rightarrow> atom fm" where
"aplus_inf (Less 0 _) = FalseF" |
"aplus_inf (Less _ 0) = TrueF" |
"aplus_inf (Less (Suc i) (Suc j)) = Atom(Less i j)" |
"aplus_inf (Eq 0 0) = TrueF" |
"aplus_inf (Eq 0 _) = FalseF" |
"aplus_inf (Eq _ 0) = FalseF" |
"aplus_inf (Eq (Suc i) (Suc j)) = Atom(Eq i j)"

abbreviation plus_inf :: "atom fm \<Rightarrow> atom fm" ("inf\<^sub>+") where
"inf\<^sub>+ \<equiv> amap\<^sub>f\<^sub>m aplus_inf"

lemma min_inf:
  "nqfree f \<Longrightarrow> \<exists>x. \<forall>y\<le>x. DLO.I (inf\<^sub>- f) xs = DLO.I f (y # xs)"
  (is "_ \<Longrightarrow> \<exists>x. ?P f x")
proof(induct f)
  case (Atom a)
  show ?case
  proof (cases a rule: amin_inf.cases)
    case 1 thus ?thesis by(auto simp add:nth_Cons' linorder_not_less)
  next
    case 2 thus ?thesis
      by (simp) (metis no_lb linorder_not_less order_less_le_trans)
  next
    case 5 thus ?thesis
      by(simp add:nth_Cons') (metis no_lb linorder_not_less)
  next
    case 6 thus ?thesis by simp (metis no_lb linorder_not_less)
  qed simp_all
next
  case (And f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (And f1 f2) (min x1 x2)" by(force simp:and_def)
  thus ?case ..
next
  case (Or f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (Or f1 f2) (min x1 x2)" by(force simp:or_def)
  thus ?case ..
qed simp_all

lemma plus_inf:
  "nqfree f \<Longrightarrow> \<exists>x.\<forall>y\<ge>x. DLO.I (inf\<^sub>+ f) xs = DLO.I f (y # xs)"
  (is "_ \<Longrightarrow> \<exists>x. ?P f x")
proof (induct f)
  have dlo_bound: "\<And>z::'a. \<exists>x. \<forall>y\<ge>x. y > z"
  proof -
    fix z
    from no_ub obtain w :: 'a where "w > z" ..
    then have "\<forall>y\<ge>w. y > z" by auto
    then show "?thesis z" ..
  qed
  case (Atom a)
  show ?case
  proof (cases a rule: aplus_inf.cases)
    case 1 thus ?thesis
      by (simp add: nth_Cons') (metis linorder_not_less)
  next
    case 2 thus ?thesis by (auto intro: dlo_bound)
  next
    case 5 thus ?thesis
      by simp (metis dlo_bound less_imp_neq)
  next
    case 6 thus ?thesis
      by simp (metis dlo_bound less_imp_neq)
  qed simp_all
next
  case (And f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (And f1 f2) (max x1 x2)" by(force simp:and_def)
  thus ?case ..
next
  case (Or f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (Or f1 f2) (max x1 x2)" by(force simp:or_def)
  thus ?case ..
qed simp_all

context notes [[simp_depth_limit=2]]
begin

lemma LBex:
 "\<lbrakk> nqfree f; DLO.I f (x#xs); \<not>DLO.I (inf\<^sub>- f) xs; x \<notin> EQ f xs \<rbrakk>
  \<Longrightarrow> \<exists>l\<in> LB f xs. l < x"
proof(induct f)
  case (Atom a) thus ?case
    by (cases a rule: amin_inf.cases)
       (simp_all add: nth.simps EQ_def split: nat.splits)
qed auto

lemma UBex:
 "\<lbrakk> nqfree f; DLO.I f (x#xs); \<not>DLO.I (inf\<^sub>+ f) xs; x \<notin> EQ f xs \<rbrakk>
  \<Longrightarrow> \<exists>u \<in> UB f xs. x < u"
proof(induct f)
  case (Atom a) thus ?case
    by (cases a rule: aplus_inf.cases)
       (simp_all add: nth.simps EQ_def split: nat.splits)
qed auto

end

lemma finite_LB: "finite(LB f xs)"
proof -
  have "LB f xs = (\<lambda>k. xs!k) ` set(lbounds(DLO.atoms\<^sub>0 f))"
    by (auto simp:set_lbounds image_def)
  thus ?thesis by simp
qed

lemma finite_UB: "finite(UB f xs)"
proof -
  have "UB f xs = (\<lambda>k.  xs!k) ` set(ubounds(DLO.atoms\<^sub>0 f))"
    by (auto simp:set_ubounds image_def)
  thus ?thesis by simp
qed

lemma qfree_amin_inf: "qfree (amin_inf a)"
by(cases a rule:amin_inf.cases) simp_all

lemma qfree_min_inf: "nqfree \<phi> \<Longrightarrow> qfree(inf\<^sub>- \<phi>)"
by(induct \<phi>)(simp_all add:qfree_amin_inf)

lemma qfree_aplus_inf: "qfree (aplus_inf a)"
by(cases a rule:aplus_inf.cases) simp_all

lemma qfree_plus_inf: "nqfree \<phi> \<Longrightarrow> qfree(inf\<^sub>+ \<phi>)"
by(induct \<phi>)(simp_all add:qfree_aplus_inf)

end


theory Hotel_Example
imports Main
begin

datatype guest = Guest0 | Guest1
datatype key = Key0 | Key1 | Key2 | Key3
datatype room = Room0

type_synonym card = "key * key"

datatype event =
   Check_in guest room card | Enter guest room card | Exit guest room

definition initk :: "room \<Rightarrow> key"
  where "initk = (%r. Key0)"

declare initk_def[code_pred_def, code]

primrec owns :: "event list \<Rightarrow> room \<Rightarrow> guest option"
where
  "owns [] r = None"
| "owns (e#s) r = (case e of
    Check_in g r' c \<Rightarrow> if r' = r then Some g else owns s r |
    Enter g r' c \<Rightarrow> owns s r |
    Exit g r' \<Rightarrow> owns s r)"

primrec currk :: "event list \<Rightarrow> room \<Rightarrow> key"
where
  "currk [] r = initk r"
| "currk (e#s) r = (let k = currk s r in
    case e of Check_in g r' (k1, k2) \<Rightarrow> if r' = r then k2 else k
            | Enter g r' c \<Rightarrow> k
            | Exit g r \<Rightarrow> k)"

primrec issued :: "event list \<Rightarrow> key set"
where
  "issued [] = range initk"
| "issued (e#s) = issued s \<union>
  (case e of Check_in g r (k1, k2) \<Rightarrow> {k2} | Enter g r c \<Rightarrow> {} | Exit g r \<Rightarrow> {})"

primrec cards :: "event list \<Rightarrow> guest \<Rightarrow> card set"
where
  "cards [] g = {}"
| "cards (e#s) g = (let C = cards s g in
                    case e of Check_in g' r c \<Rightarrow> if g' = g then insert c C
                                                else C
                            | Enter g r c \<Rightarrow> C
                            | Exit g r \<Rightarrow> C)"

primrec roomk :: "event list \<Rightarrow> room \<Rightarrow> key"
where
  "roomk [] r = initk r"
| "roomk (e#s) r = (let k = roomk s r in
    case e of Check_in g r' c \<Rightarrow> k
            | Enter g r' (x,y) \<Rightarrow> if r' = r \<^cancel>\<open>\<and> x = k\<close> then y else k
            | Exit g r \<Rightarrow> k)"

primrec isin :: "event list \<Rightarrow> room \<Rightarrow> guest set"
where
  "isin [] r = {}"
| "isin (e#s) r = (let G = isin s r in
                 case e of Check_in g r c \<Rightarrow> G
                 | Enter g r' c \<Rightarrow> if r' = r then {g} \<union> G else G
                 | Exit g r' \<Rightarrow> if r'=r then G - {g} else G)"

primrec hotel :: "event list \<Rightarrow> bool"
where
  "hotel []  = True"
| "hotel (e # s) = (hotel s \<and> (case e of
  Check_in g r (k,k') \<Rightarrow> k = currk s r \<and> k' \<notin> issued s |
  Enter g r (k,k') \<Rightarrow> (k,k') \<in> cards s g \<and> (roomk s r \<in> {k, k'}) |
  Exit g r \<Rightarrow> g \<in> isin s r))"

definition no_Check_in :: "event list \<Rightarrow> room \<Rightarrow> bool" where(*>*)
[code del]: "no_Check_in s r \<equiv> \<not>(\<exists>g c. Check_in g r c \<in> set s)"

definition feels_safe :: "event list \<Rightarrow> room \<Rightarrow> bool"
where
  "feels_safe s r = (\<exists>s\<^sub>1 s\<^sub>2 s\<^sub>3 g c c'.
   s = s\<^sub>3 @ [Enter g r c] @ s\<^sub>2 @ [Check_in g r c'] @ s\<^sub>1 \<and>
   no_Check_in (s\<^sub>3 @ s\<^sub>2) r \<and> isin (s\<^sub>2 @ [Check_in g r c] @ s\<^sub>1) r = {})"

section \<open>Some setup\<close>

lemma issued_nil: "issued [] = {Key0}"
by (auto simp add: initk_def)

lemmas issued_simps[code, code_pred_def] = issued_nil issued.simps(2)

end


(*  Title:       Preservation and respectfulness theorems for coinductive lists
    Author:      Andreas Lochbihler
    Maintainer:  Andreas Lochbihler
*)

header {* Setup for Isabelle's quotient package for lazy lists *}

theory Quotient_Coinductive_List imports
  "~~/src/HOL/Library/Quotient_List"
  "~~/src/HOL/Library/Quotient_Set"
  Coinductive_List
begin

subsection {* Rules for the Quotient package *}

declare llist.rel_eq[id_simps]

lemma transpD: "\<lbrakk> transp R; R a b; R b c \<rbrakk> \<Longrightarrow> R a c"
  by (erule transpE) blast

lemma id_respect [quot_respect]:
  "(R ===> R) id id"
  by (fact id_rsp)

lemma id_preserve [quot_preserve]:
  assumes "Quotient3 R Abs Rep"
  shows "(Rep ---> Abs) id = id"
  using Quotient3_abs_rep [OF assms] by (simp add: fun_eq_iff)

functor lmap: lmap
   by (simp_all add: fun_eq_iff id_def llist.map_comp)

declare llist.map_id0 [id_simps]

lemma reflp_llist_all2: "reflp R \<Longrightarrow> reflp (llist_all2 R)"
  by (rule reflpI) (auto simp add: llist_all2_conv_all_lnth elim: reflpE)

lemma symp_llist_all2: "symp R \<Longrightarrow> symp (llist_all2 R)"
  by (rule sympI) (auto simp add: llist_all2_conv_all_lnth elim: sympE)

lemma transp_llist_all2: "transp R \<Longrightarrow> transp (llist_all2 R)"
  by (rule transpI) (rule llist_all2_trans)

lemma llist_equivp [quot_equiv]:
  "equivp R \<Longrightarrow> equivp (llist_all2 R)"
  by (simp add: equivp_reflp_symp_transp reflp_llist_all2 symp_llist_all2 transp_llist_all2)

lemma unfold_llist_preserve [quot_preserve]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and q2: "Quotient3 R2 Abs2 Rep2"
  shows "((Abs1 ---> id) ---> (Abs1 ---> Rep2) ---> (Abs1 ---> Rep1) ---> Rep1 ---> lmap Abs2) unfold_llist = unfold_llist"
  (is "?lhs = ?rhs")
proof(intro ext)
  fix IS_LNIL LHD LTL a
  show "?lhs IS_LNIL LHD LTL a = ?rhs IS_LNIL LHD LTL a"
    by(coinduction arbitrary: a)(auto simp add: Quotient3_abs_rep[OF q1] Quotient3_abs_rep[OF q2])
qed

lemma Quotient_lmap_Abs_Rep:
  "Quotient3 R Abs Rep \<Longrightarrow> lmap Abs (lmap Rep a) = a"
  by (drule abs_o_rep) (simp add: llist.map_id0 llist.map_comp)

lemma llist_all2_rel:
  assumes "Quotient3 R Abs Rep"
  shows "llist_all2 R r s \<longleftrightarrow> llist_all2 R r r \<and> llist_all2 R s s \<and> (lmap Abs r = lmap Abs s)"
  (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume "?lhs"
  hence "llist_all2 R r r"
    apply -
    apply(rule llist_all2_reflI)
    apply(clarsimp simp add: lset_conv_lnth)
    apply(metis Quotient3_rel[OF assms] llist_all2_lnthD)
    done
  moreover from `?lhs` have "llist_all2 R s s"
    apply -
    apply(rule llist_all2_reflI)
    apply(clarsimp simp add: lset_conv_lnth)
    apply(metis Quotient3_rel[OF assms] llist_all2_lnthD2)
    done
  moreover from `?lhs` have "llength r = llength s" by(rule llist_all2_llengthD)
  hence "lmap Abs r = lmap Abs s" using `?lhs`
    unfolding lmap_eq_lmap_conv_llist_all2
    apply -
    apply(erule llist_all2_all_lnthI)
    apply(drule (1) llist_all2_lnthD)
    apply(metis Quotient3_rel[OF assms])
    done
  ultimately show ?rhs by blast
next
  assume ?rhs thus ?lhs
    unfolding lmap_eq_lmap_conv_llist_all2
    by(clarsimp simp add: llist_all2_conv_all_lnth simp del: llist_all2_same)(metis Quotient3_rel[OF assms])
qed

lemma Quotient_llist_all2_lmap_Rep:
  "Quotient3 R Abs Rep \<Longrightarrow> llist_all2 R (lmap Rep a) (lmap Rep a)"
by(auto intro!: llist_all2_all_lnthI intro: Quotient3_rep_reflp)

lemma llist_quotient [quot_thm]:
  "Quotient3 R Abs Rep \<Longrightarrow> Quotient3 (llist_all2 R) (lmap Abs) (lmap Rep)"
by(blast intro: Quotient3I dest: Quotient_lmap_Abs_Rep Quotient_llist_all2_lmap_Rep llist_all2_rel)

declare [[mapQ3 llist = (llist_all2, llist_quotient)]]

lemma LCons_preserve [quot_preserve]:
  assumes "Quotient3 R Abs Rep"
  shows "(Rep ---> (lmap Rep) ---> (lmap Abs)) LCons = LCons"
using Quotient3_abs_rep[OF assms]
by(simp add: fun_eq_iff llist.map_comp o_def)

lemmas LCons_respect [quot_respect] = LCons_transfer

lemma LNil_preserve [quot_preserve]:
  "lmap Abs LNil = LNil"
by simp

lemmas LNil_respect [quot_respect] = LNil_transfer

lemma lmap_preserve [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> rep2) ---> (lmap rep1) ---> (lmap abs2)) lmap = lmap"
  and   "((abs1 ---> id) ---> lmap rep1 ---> id) lmap = lmap"
using Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b]
by(simp_all add: fun_eq_iff llist.map_comp o_def)

lemma lmap_respect [quot_respect]:
  shows "((R1 ===> R2) ===> (llist_all2 R1) ===> llist_all2 R2) lmap lmap"
  and   "((R1 ===> op =) ===> (llist_all2 R1) ===> op =) lmap lmap"
by(fact lmap_transfer)(simp add: llist_all2_conv_all_lnth lmap_eq_lmap_conv_llist_all2 rel_fun_def)

lemmas llist_all2_respect [quot_respect] = llist_all2_transfer

lemma llist_all2_preserve [quot_preserve]:
  assumes "Quotient3 R Abs Rep"
  shows "((Abs ---> Abs ---> id) ---> lmap Rep ---> lmap Rep ---> id) llist_all2 = llist_all2"
using Quotient3_abs_rep[OF assms]
by(simp add: fun_eq_iff llist_all2_lmap1 llist_all2_lmap2)

lemma llist_all2_preserve2 [quot_preserve]:
  assumes "Quotient3 R Abs Rep"
  shows "(llist_all2 ((Rep ---> Rep ---> id) R) l m) = (l = m)"
  by (simp add: map_fun_def [abs_def] Quotient3_rel_rep [OF assms] llist.rel_eq comp_def)

lemma corec_llist_preserve [quot_preserve]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and q2: "Quotient3 R2 Abs2 Rep2"
  shows "((Abs1 ---> id) ---> (Abs1 ---> Rep2) ---> (Abs1 ---> id) --->
          (Abs1 ---> lmap Rep2) ---> (Abs1 ---> Rep1) ---> Rep1 ---> lmap Abs2) corec_llist = corec_llist"
  (is "?lhs = ?rhs")
proof(intro ext)
  fix IS_LNIL LHD endORmore LTL_end LTL_more b
  show "?lhs IS_LNIL LHD endORmore LTL_end LTL_more b = ?rhs IS_LNIL LHD endORmore LTL_end LTL_more b"
    by(coinduction arbitrary: b rule: llist.coinduct_strong)
      (auto simp add: Quotient3_abs_rep[OF q1] Quotient3_abs_rep[OF q2] Quotient_lmap_Abs_Rep[OF q2])
qed

end


chapter \<open>Forward Analysis with DBMs and Widening\<close>

theory Normalized_Zone_Semantics
  imports DBM_Zone_Semantics Approx_Beta
begin

section \<open>DBM-based Semantics with Normalization\<close>

subsection \<open>Single Step\<close>

inductive step_z_norm ::
  "('a, 'c, t, 's) ta \<Rightarrow> 's \<Rightarrow> t DBM \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> ('c \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> t DBM \<Rightarrow> bool"
("_ \<turnstile> \<langle>_, _\<rangle> \<leadsto>\<^bsub>_,_,_\<^esub> \<langle>_, _\<rangle>" [61,61,61,61,61] 61)
where step_z_norm:
  "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^bsub>v,n\<^esub> \<langle>l', D'\<rangle> \<Longrightarrow> A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^bsub>k,v,n\<^esub> \<langle>l', norm (FW D' n) k n\<rangle>"

inductive steps_z_norm ::
  "('a, 'c, t, 's) ta \<Rightarrow> 's \<Rightarrow> t DBM \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> ('c \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> t DBM \<Rightarrow> bool"
("_ \<turnstile> \<langle>_, _\<rangle> \<leadsto>\<^bsub>_,_,_\<^esub>* \<langle>_, _\<rangle>" [61,61,61,61,61] 61)
where
  refl: "A \<turnstile> \<langle>l, Z\<rangle>  \<leadsto>\<^bsub>k,v,n\<^esub>* \<langle>l, Z\<rangle>" |
  step: "A \<turnstile> \<langle>l, Z\<rangle>  \<leadsto>\<^bsub>k,v,n\<^esub>* \<langle>l', Z'\<rangle> \<Longrightarrow> A \<turnstile> \<langle>l', Z'\<rangle> \<leadsto>\<^bsub>k,v,n\<^esub> \<langle>l'', Z''\<rangle>
        \<Longrightarrow> A \<turnstile> \<langle>l, Z\<rangle> \<leadsto>\<^bsub>k,v,n\<^esub>* \<langle>l'', Z''\<rangle>"

context Regions
begin

abbreviation "v' \<equiv> beta_interp.v'"

abbreviation step_z_norm' ("_ \<turnstile> \<langle>_, _\<rangle> \<leadsto>\<^sub>\<N> \<langle>_, _\<rangle>" [61,61,61] 61)
where
  "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N> \<langle>l', D'\<rangle> \<equiv> A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub> \<langle>l', D'\<rangle>"

abbreviation steps_z_norm' ("_ \<turnstile> \<langle>_, _\<rangle> \<leadsto>\<^sub>\<N>* \<langle>_, _\<rangle>" [61,61,61] 61)
where
  "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l', D'\<rangle> \<equiv> A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub>* \<langle>l', D'\<rangle>"

inductive_cases[elim!]: "A \<turnstile> \<langle>l, u\<rangle> \<leadsto>\<^sub>\<N> \<langle>l',u'\<rangle>"

declare step_z_norm.intros[intro]

lemma apx_empty_iff'':
  assumes "canonical M1 n" "[M1]\<^bsub>v,n\<^esub> \<subseteq> V" "dbm_int M1 n"
  shows "[M1]\<^bsub>v,n\<^esub> = {} \<longleftrightarrow> [norm M1 (k o v') n]\<^bsub>v,n\<^esub> = {}"
using beta_interp.apx_norm_eq[OF assms] apx_empty_iff'[of "[M1]\<^bsub>v,n\<^esub>"] assms unfolding V'_def by blast

inductive valid_dbm where
  "[M]\<^bsub>v,n\<^esub> \<subseteq> V \<Longrightarrow> dbm_int M n \<Longrightarrow> valid_dbm M"

inductive_cases valid_dbm_cases[elim]: "valid_dbm M"

declare valid_dbm.intros[intro]

lemma step_z_valid_dbm:
  assumes "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^bsub>v,n\<^esub> \<langle>l', D'\<rangle>"
    and "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "valid_dbm D'"
proof -
  from alpha_interp.step_z_V step_z_dbm_sound[OF assms(1,2)] step_z_dbm_preserves_int[OF assms(1,2)]
       assms(3,4)
  have
    "dbm_int D' n" "A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto> \<langle>l', [D']\<^bsub>v,n\<^esub>\<rangle>"
  by fastforce+
  with alpha_interp.step_z_V[OF this(2)] assms(4) show ?thesis by auto
qed

lemma FW_zone_equiv_spec:
  shows "[M]\<^bsub>v,n\<^esub> = [FW M n]\<^bsub>v,n\<^esub>"
apply (rule FW_zone_equiv) using clock_numbering(2) by auto

lemma cn_weak: "\<forall>k\<le>n. 0 < k \<longrightarrow> (\<exists>c. v c = k)" using clock_numbering(2) by blast

lemma valid_dbm_non_empty_diag:
  assumes "valid_dbm M" "[M]\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "\<forall> k \<le> n. M k k \<ge> \<one>"
proof safe
  fix k assume k: "k \<le> n"
  have "\<forall>k\<le>n. 0 < k \<longrightarrow> (\<exists>c. v c = k)" using clock_numbering(2) by blast
  from k not_empty_cyc_free[OF this assms(2)] show "\<one> \<le> M k k" by (simp add: cyc_free_diag_dest')
qed

lemma non_empty_cycle_free:
  assumes "[M]\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "cycle_free M n"
by (meson assms clock_numbering(2) neg_cycle_empty negative_cycle_dest_diag)

lemma norm_empty_diag_preservation:
  assumes "i \<le> n"
  assumes "M i i < Le 0"
  shows "norm M (k o v') n i i < Le 0"
proof -
  have "\<not> Le (k (v' i)) \<prec> Le 0" by auto
  with assms show ?thesis unfolding norm_def by (auto simp: Let_def less)
qed

lemma norm_FW_empty:
  assumes "valid_dbm M"
  assumes "[M]\<^bsub>v,n\<^esub> = {}"
  shows "[norm (FW M n) (k o v') n]\<^bsub>v,n\<^esub> = {}" (is "[?M]\<^bsub>v,n\<^esub> = {}")
proof -
  from assms(2) cyc_free_not_empty clock_numbering(1) cycle_free_diag_equiv have "\<not> cycle_free M n"
  by metis
  from FW_neg_cycle_detect[OF this] obtain i where i: "i \<le> n" "FW M n i i < \<one>" by auto
  with norm_empty_diag_preservation[folded neutral] have "?M i i < \<one>" .
  with \<open>i \<le> n\<close> show ?thesis using beta_interp.neg_diag_empty_spec by auto
qed

lemma apx_norm_eq_spec:
  assumes "valid_dbm M"
    and "[M]\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "beta_interp.Approx\<^sub>\<beta> ([M]\<^bsub>v,n\<^esub>) = [norm (FW M n) (k o v') n]\<^bsub>v,n\<^esub>"
proof -
  note cyc_free = non_empty_cycle_free[OF assms(2)]
  from assms(1) FW_zone_equiv_spec[of M] have "[M]\<^bsub>v,n\<^esub> = [FW M n]\<^bsub>v,n\<^esub>" by (auto simp: neutral)
  with beta_interp.apx_norm_eq[OF fw_canonical[OF cyc_free] _ FW_int_preservation]
      valid_dbm_non_empty_diag[OF assms(1,2)] assms(1)
 show "Approx\<^sub>\<beta> ([M]\<^bsub>v,n\<^esub>) = [norm (FW M n) (k o v') n]\<^bsub>v,n\<^esub>" by auto

qed

print_statement step_z_norm.inducts

(* Crudely copied from step_z_norm.inducts *)
lemma step_z_norm_induct[case_names _ step_z_norm step_z_refl]:
  assumes "x1 \<turnstile> \<langle>x2, x3\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub> \<langle>x7,x8\<rangle>"
    and step_z_norm:
    "\<And>A l D l' D'.
        A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^bsub>v,n\<^esub> \<langle>l',D'\<rangle> \<Longrightarrow>
        P A l D l' (norm (FW D' n) (k o v') n)"
  shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: step_z_norm.inducts) auto

lemma FW_valid_preservation:
  assumes "valid_dbm M"
  shows "valid_dbm (FW M n)"
proof standard
  from FW_int_preservation assms show "dbm_int (FW M n) n" by blast
next
  from FW_zone_equiv_spec[of M, folded neutral] assms show "[FW M n]\<^bsub>v,n\<^esub> \<subseteq> V" by fastforce
qed

text \<open>Obsolete\<close>
lemma norm_diag_preservation:
  assumes "\<forall>l\<le>n. M1 l l \<le> \<one>"
  shows "\<forall>l\<le>n. (norm M1 (k o v') n) l l \<le> \<one>" (is "\<forall> l \<le> n. ?M l l \<le> \<one>")
proof safe
  fix j assume j: "j \<le> n"
  show "?M j j \<le> \<one>"
  proof (cases "j = 0")
    case True
    with j assms show ?thesis unfolding norm_def neutral less_eq dbm_le_def by auto
  next
    case False
    have *: "real ((k \<circ> v') j) \<ge> 0" by auto
    from j assms have **: "M1 j j \<le> Le 0" unfolding neutral by auto
    have "norm_upper (M1 j j) (real ((k \<circ> v') j)) = M1 j j"
    using * ** apply (cases "M1 j j") apply auto by fastforce+
    with assms(1) j False have
      "?M j j = norm_lower (M1 j j) (- real ((k \<circ> v') j))"
    unfolding norm_def by auto
    with ** show ?thesis unfolding neutral by auto
  qed
qed

lemma norm_FW_valid_preservation_non_empty:
  assumes "valid_dbm M" "[M]\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
  from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
  show ?thesis
  proof standard
    from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
  next
    from fw_canonical[OF non_empty_cycle_free] assms have "canonical (FW M n) n" by auto
    from beta_interp.norm_V_preservation[OF _ this ] valid show "[?M]\<^bsub>v,n\<^esub> \<subseteq> V" by fast
  qed
qed

lemma norm_FW_valid_preservation_empty:
  assumes "valid_dbm M" "[M]\<^bsub>v,n\<^esub> = {}"
  shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
  from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
  show ?thesis
  proof standard
    from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
  next
    from norm_FW_empty[OF assms(1,2)] show "[?M]\<^bsub>v,n\<^esub> \<subseteq> V" by fast
  qed
qed

lemma norm_beta_sound:
  assumes "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N> \<langle>l',D'\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  shows   "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta> \<langle>l',[D']\<^bsub>v,n\<^esub>\<rangle>" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
  case (step_z_norm A l D l' D')
  from step_z_dbm_sound[OF step_z_norm(1,2)] have "A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto> \<langle>l',[D']\<^bsub>v,n\<^esub>\<rangle>" by blast
  then have *: "A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta> \<langle>l',Approx\<^sub>\<beta> ([D']\<^bsub>v,n\<^esub>)\<rangle>" by force
  show ?case
  proof (cases "[D']\<^bsub>v,n\<^esub> = {}")
    case False
    from apx_norm_eq_spec[OF step_z_valid_dbm[OF step_z_norm] False] *
    show ?thesis by auto
  next
    case True
    with norm_FW_empty[OF step_z_valid_dbm[OF step_z_norm] this] beta_interp.apx_empty *
    show ?thesis by auto
  qed
qed

lemma step_z_norm_valid_dbm:
  assumes "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N> \<langle>l',D'\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
  case (step_z_norm A l D l' D')
  with norm_FW_valid_preservation[OF step_z_valid_dbm[OF step_z_norm]] show ?case by fast
qed

lemma norm_beta_complete:
  assumes "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta> \<langle>l',Z\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  obtains D' where "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N> \<langle>l',D'\<rangle>" "[D']\<^bsub>v,n\<^esub> = Z" "valid_dbm D'"
proof -
  from assms(1) obtain Z' where Z': "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto> \<langle>l',Z'\<rangle>" "Z = Approx\<^sub>\<beta> Z'" by auto
  from assms(4) have "dbm_int D n" by auto
  with step_z_dbm_DBM[OF Z'(1) assms(2)] step_z_dbm_preserves_int[OF _ assms(2,3)] obtain D' where
    D': "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^bsub>v,n\<^esub> \<langle>l',D'\<rangle>" "Z' = [D']\<^bsub>v,n\<^esub>" "dbm_int D' n"
  by auto
  note valid_D' = step_z_valid_dbm[OF D'(1) assms(2,3)]
  obtain D'' where D'': "D'' = norm (FW D' n) (k \<circ> v') n" by auto
  show ?thesis
  proof (cases "Z' = {}")
    case False
    with D' have *: "[D']\<^bsub>v,n\<^esub> \<noteq> {}" by auto
    from apx_norm_eq_spec[OF valid_D' this] D'' D'(2) Z'(2) assms(4) have "Z = [D'']\<^bsub>v,n\<^esub>" by auto
    with norm_FW_valid_preservation[OF valid_D'] D' D'' * that[of D''] assms(4)
    show thesis by blast
  next
    case True
    with norm_FW_empty[OF valid_D'[OF assms(4)]] D'' D' Z'(2)
         norm_FW_valid_preservation[OF valid_D'[OF assms(4)]] beta_interp.apx_empty
    show thesis
    apply -
    apply (rule that[of D''])
      apply blast
    by fastforce+
  qed
qed

subsection \<open>Multi step\<close>

declare steps_z_norm.intros[intro]

lemma steps_z_norm_induct[case_names _ refl step]:
  assumes "x1 \<turnstile> \<langle>x2, x3\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub>* \<langle>x7,x8\<rangle>"
    and "\<And>A l Z. P A l Z l Z"
    and
    "\<And>A l Z l' Z' l'' Z''.
        A \<turnstile> \<langle>l, Z\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub>* \<langle>l',Z'\<rangle> \<Longrightarrow>
        P A l Z l' Z' \<Longrightarrow>
        A \<turnstile> \<langle>l', Z'\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub> \<langle>l'',Z''\<rangle> \<Longrightarrow> P A l Z l'' Z''"
  shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: steps_z_norm.induct) auto

lemma norm_beta_sound_multi:
  assumes "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',[D']\<^bsub>v,n\<^esub>\<rangle> \<and> valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: steps_z_norm_induct, intro assms(1))
  case refl then show ?case by fast
next
  case (step A l Z l' Z' l'' Z'')
  then have "A \<turnstile> \<langle>l, [Z]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',[Z']\<^bsub>v,n\<^esub>\<rangle>" "valid_dbm Z'" by fast+
  with norm_beta_sound[OF step(2,4,5)] step_z_norm_valid_dbm[OF step(2,4,5)] show ?case by force
qed

lemma norm_beta_complete_multi:
  assumes "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',Z\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  obtains D' where "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle>" "[D']\<^bsub>v,n\<^esub> = Z" "valid_dbm D'"
using assms
proof (induction A l "[D]\<^bsub>v,n\<^esub>" l' Z arbitrary: thesis rule: steps_z_beta.induct)
  case refl
  from this(1)[OF steps_z_norm.refl] this(4) show thesis by fast
next
  case (step A l l' Z' l'' Z'')
  from step(2)[OF _ step(5,6,7)] obtain D' where D':
    "A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle>" "[D']\<^bsub>v,n\<^esub> = Z'" "valid_dbm D'"
  .
  with norm_beta_complete[OF _ step(5,6), of l' D' l'' Z''] step(3) obtain D'' where D'':
    "A \<turnstile> \<langle>l', D'\<rangle> \<leadsto>\<^sub>\<N> \<langle>l'',D''\<rangle>" "[D'']\<^bsub>v,n\<^esub> = Z''" "valid_dbm D''"
  by auto
  with D'(1) step(4)[of D''] show thesis by blast
qed

lemma norm_beta_equiv_multi:
  assumes "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  shows "(\<exists> D'. A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle> \<and> Z = [D']\<^bsub>v,n\<^esub>) \<longleftrightarrow> A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',Z\<rangle>"
using norm_beta_complete_multi[OF _ assms] norm_beta_sound_multi[OF _ assms] by metis

subsection \<open>Connecting with Correctness Results for Approximating Semantics\<close>

lemma steps_z_norm_complete':
  assumes "A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>* \<langle>l',Z\<rangle>" "global_clock_numbering A v n" "valid_abstraction A X k"
  and "valid_dbm D"
  shows "\<exists> D'. A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle> \<and>  Z \<subseteq> [D']\<^bsub>v,n\<^esub>"
proof -
  from steps_z_beta_complete[OF assms(1,3)] assms(4) obtain Z'' where Z'':
    "A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',Z''\<rangle>" "Z \<subseteq> Z''"
  by auto
  from this(2) norm_beta_complete_multi[OF this(1) assms(2,3,4)] show ?thesis by metis
qed

lemma valid_dbm_V':
  assumes "valid_dbm M"
  shows "[M]\<^bsub>v,n\<^esub> \<in> V'"
using assms unfolding V'_def by force

lemma steps_z_norm_sound':
  assumes "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle>"
    and "global_clock_numbering A v n"
    and "valid_abstraction A X k"
    and "valid_dbm D"
    and "[D']\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "\<exists>Z. A \<turnstile> \<langle>l,[D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>* \<langle>l',Z\<rangle> \<and> Z \<noteq> {}"
proof -
  from norm_beta_sound_multi[OF assms(1-4)] have "A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>\<^sub>\<beta>* \<langle>l',[D']\<^bsub>v,n\<^esub>\<rangle>" by fast
  from steps_z_beta_sound[OF this _ assms(3) valid_dbm_V'] assms(2,4,5) show ?thesis by blast
qed

section \<open>The Final Result About Language Emptiness\<close>

lemma steps_z_norm_complete:
  assumes "A \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle>" "u \<in> [D]\<^bsub>v,n\<^esub>"
    and   "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "\<exists> D'. A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle> \<and> u' \<in> [D']\<^bsub>v,n\<^esub>"
using steps_z_norm_complete'[OF _ assms(3-)] steps_z_complete[OF assms(1,2)] by fast

lemma steps_z_norm_sound:
  assumes "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle>"
    and   "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
    and   "[D']\<^bsub>v,n\<^esub> \<noteq> {}"
  shows "\<exists> u \<in> [D]\<^bsub>v,n\<^esub>. \<exists> u'. A \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle>"
using steps_z_norm_sound'[OF assms] steps_z_sound by fast

theorem steps_z_norm_decides_emptiness:
  assumes "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "(\<exists> D'. A \<turnstile> \<langle>l, D\<rangle> \<leadsto>\<^sub>\<N>* \<langle>l',D'\<rangle> \<and> [D']\<^bsub>v,n\<^esub> \<noteq> {})
     \<longleftrightarrow> (\<exists> u \<in> [D]\<^bsub>v,n\<^esub>. \<exists> u'. A \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle>)"
using steps_z_norm_sound[OF _ assms] steps_z_norm_complete[OF _ _ assms] by fast

section \<open>Finiteness of the Search Space\<close>

abbreviation "dbm_default M \<equiv> (\<forall> i > n. \<forall> j. M i j = \<one>) \<and> (\<forall> j > n. \<forall> i. M i j = \<one>)"

lemma "a \<in> \<int> \<Longrightarrow> \<exists> b. a = real_of_int b" using Ints_cases by auto

lemma norm_default_preservation:
  "dbm_default M \<Longrightarrow> dbm_default (norm M (k o v') n)"
by (simp add: norm_def)

lemma normalized_integral_dbms_finite:
  "finite {norm M (k o v') n | M. dbm_int M n \<and> dbm_default M}"
proof -
  let ?u = "Max {(k o v') i | i. i \<le> n}" let ?l = "- ?u"
  let ?S = "(Le ` {d :: int. ?l \<le> d \<and> d \<le> ?u}) \<union> (Lt ` {d :: int. ?l \<le> d \<and> d \<le> ?u}) \<union> {\<infinity>}"
  from finite_set_of_finite_funs2[of "{0..n}" "{0..n}" ?S] have fin:
    "finite {f. \<forall>x y. (x \<in> {0..n} \<and> y \<in> {0..n} \<longrightarrow> f x y \<in> ?S)
                \<and> (x \<notin> {0..n} \<longrightarrow> f x y = \<one>) \<and> (y \<notin> {0..n} \<longrightarrow> f x y = \<one>)}" (is "finite ?R")
  by auto
  { fix M :: "t DBM" assume A: "dbm_int M n" "dbm_default M"
    let ?M = "norm M (k o v') n"
    from beta_interp.norm_int_preservation[OF A(1)] norm_default_preservation[OF A(2)] have
      A: "dbm_int ?M n" "dbm_default ?M"
    by blast+
    { fix i j assume "i \<in> {0..n}" "j \<in> {0..n}"
      then have B: "i \<le> n" "j \<le> n" by auto
      have "?M i j \<in> ?S"
      proof (cases "?M i j = \<infinity>")
        case True then show ?thesis by auto
      next
        case False
        note not_inf = this
        with B A(1) have "get_const (?M i j) \<in> \<int>" by auto
        moreover have "?l \<le> get_const (?M i j) \<and> get_const (?M i j) \<le> ?u"
        proof (cases "i = 0")
          case True
          show ?thesis
          proof (cases "j = 0")
            case True
            with \<open>i = 0\<close> A(1) B have
              "?M i j = norm_lower (norm_upper (M 0 0) 0) 0"
            unfolding norm_def by auto
            also have "\<dots> \<noteq> \<infinity> \<longrightarrow> get_const \<dots> = 0" by (cases "M 0 0"; fastforce)
            finally show ?thesis using not_inf by auto
          next
            case False
            with \<open>i = 0\<close> B not_inf have "?M i j \<le> Le 0" "Lt (-real (k (v' j))) \<le> ?M i j"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "get_const (?M i j) \<le> 0" "-k (v' j) \<le> get_const (?M i j)"
            by (cases "?M i j"; auto)+
            moreover from \<open>j \<le> n\<close> have "- (k o v') j \<ge> ?l" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          qed
        next
          case False
          then have "i > 0" by simp
          show ?thesis
          proof (cases "j = 0")
            case True
            with \<open>i > 0\<close> A(1) B not_inf have "Lt 0 \<le> ?M i j" "?M i j \<le> Le (real ((k \<circ> v') i))"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "0 \<le> get_const (?M i j)" "get_const (?M i j) \<le> k (v' i)"
            by (cases "?M i j"; auto)+
            moreover from \<open>i \<le> n\<close> have "(k o v') i \<le> ?u" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          next
            case False
            with \<open>i > 0\<close> A(1) B not_inf have
              "Lt (-real ((k \<circ> v') j)) \<le> ?M i j" "?M i j \<le> Le (real ((k \<circ> v') i))"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "- k (v' j) \<le> get_const (?M i j)" "get_const (?M i j) \<le> k (v' i)"
            by (cases "?M i j"; auto)+
            moreover from \<open>i \<le> n\<close> \<open>j \<le> n\<close> have "(k o v') i \<le> ?u" "(k o v') j \<le> ?u" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          qed
        qed
        ultimately show ?thesis by (cases "?M i j"; auto elim: Ints_cases)
      qed
    } moreover
    { fix i j assume "i \<notin> {0..n}"
      with A(2) have "?M i j = \<one>" by auto
    } moreover
    { fix i j assume "j \<notin> {0..n}"
      with A(2) have "?M i j = \<one>" by auto
    } moreover note the = calculation
  } then have "{norm M (k o v') n | M. dbm_int M n \<and> dbm_default M} \<subseteq> ?R" by blast
  with fin show ?thesis by (blast intro: finite_subset)
qed

end

section \<open>Appendix: Standard Clock Numberings for Concrete Models\<close>

locale Regions' =
  fixes X and k :: "'c \<Rightarrow> nat" and v :: "'c \<Rightarrow> nat" and n :: nat and not_in_X
  assumes finite: "finite X"
  assumes clock_numbering': "\<forall> c \<in> X. v c > 0" "\<forall> c. c \<notin> X \<longrightarrow> v c > n"
  assumes bij: "bij_betw v X {1..n}"
  assumes non_empty: "X \<noteq> {}"
  assumes not_in_X: "not_in_X \<notin> X"

begin

lemma inj: "inj_on v X" using bij_betw_imp_inj_on bij by simp

lemma cn_weak: "\<forall> c. v c > 0" using clock_numbering' by force

lemma in_X: assumes "v x \<le> n" shows "x \<in> X" using assms clock_numbering'(2) by force

end

sublocale Regions' \<subseteq> Regions
proof (unfold_locales, auto simp: finite clock_numbering' non_empty cn_weak not_in_X, goal_cases)
  case (1 x y) with inj in_X show ?case unfolding inj_on_def by auto
next
  case (2 k)
  from bij have "v ` X = {1..n}" unfolding bij_betw_def by auto
  from 2 have "k \<in> {1..n}" by simp
  then obtain x where "x \<in> X" "v x = k" unfolding image_def
  by (metis (no_types, lifting) \<open>v ` X = {1..n}\<close> imageE)
  then show ?case by blast
next
  case (3 x) with bij show ?case unfolding bij_betw_def by auto
qed

(* This is for automata carrying real time annotations *)
lemma standard_abstraction:
  assumes "finite (clkp_set A)" "finite (collect_clkvt (trans_of A))" "\<forall>(_,m::real) \<in> clkp_set A. m \<in> \<nat>"
  obtains k :: "'c \<Rightarrow> nat" where "valid_abstraction A (clk_set A) k"
proof -
  from assms have 1: "finite (clk_set A)" by auto
  have 2: "collect_clkvt (trans_of A) \<subseteq> clk_set A" by auto
  from assms obtain L where L: "distinct L" "set L = clkp_set A" by (meson finite_distinct_list)
  let ?M = "\<lambda> c. {m . (c, m) \<in> clkp_set A}"
  let ?X = "clk_set A"
  let ?m = "map_of L"
  let ?k = "\<lambda> x. if ?M x = {} then 0 else nat (floor (Max (?M x)) + 1)"
  { fix c m assume A: "(c, m) \<in> clkp_set A"
    from assms(1) have "finite (snd ` clkp_set A)" by auto
    moreover have "?M c \<subseteq> (snd ` clkp_set A)" by force
    ultimately have fin: "finite (?M c)" by (blast intro: finite_subset)
    then have "Max (?M c) \<in> {m . (c, m) \<in> clkp_set A}" using Max_in A by auto
    with assms(3) have "Max (?M c) \<in> \<nat>" by auto
    then have "floor (Max (?M c)) = Max (?M c)" by (metis Nats_cases floor_of_nat of_int_of_nat_eq)
    with A have *: "?k c = Max (?M c) + 1"
    proof auto
      fix n :: int and x :: real
      assume "Max {m. (c, m) \<in> clkp_set A} = real_of_int n"
      then have "real_of_int (n + 1) \<in> \<nat>"
        using \<open>Max {m. (c, m) \<in> clkp_set A} \<in> \<nat>\<close> by auto
      then show "real (nat (n + 1)) = real_of_int n + 1"
        by (metis Nats_cases ceiling_of_int nat_int of_int_1 of_int_add of_int_of_nat_eq)
    qed
    from fin A have "Max (?M c) \<ge> m" by auto
    moreover from A assms(3) have "m \<in> \<nat>" by auto
    ultimately have "m \<le> ?k c" "m \<in> \<nat>" "c \<in> clk_set A" using A * by force+
  }
  then have "\<forall>(x, m)\<in>clkp_set A. m \<le> ?k x \<and> x \<in> clk_set A \<and> m \<in> \<nat>" by blast
  with 1 2 have "valid_abstraction A ?X ?k" by - (standard, assumption+)
  then show thesis ..
qed

definition
  "finite_ta A \<equiv> finite (clkp_set A) \<and> finite (collect_clkvt (trans_of A))
                 \<and> (\<forall>(_,m::real) \<in> clkp_set A. m \<in> \<nat>) \<and> clk_set A \<noteq> {} \<and> -clk_set A \<noteq> {}"

lemma finite_ta_Regions':
  fixes A :: "('a, 'c, real, 's) ta"
  assumes "finite_ta A"
  obtains v n x where "Regions' (clk_set A) v n x"
proof -
  from assms obtain x where x: "x \<notin> clk_set A" unfolding finite_ta_def by auto
  from assms(1) have "finite (clk_set A)" unfolding finite_ta_def by auto
  with standard_numbering[of "clk_set A"] assms obtain v and n :: nat where
            "bij_betw v (clk_set A) {1..n}"
            "\<forall>c\<in>clk_set A. 0 < v c" "\<forall>c. c \<notin> clk_set A \<longrightarrow> n < v c"
  by auto
  then have "Regions' (clk_set A) v n x" using x assms unfolding finite_ta_def by - (standard, auto)
  then show ?thesis ..
qed

definition valid_dbm where "valid_dbm M n \<equiv> dbm_int M n \<and> (\<forall> i \<le> n. M 0 i \<le> \<one>)"

lemma dbm_positive:
  assumes "M 0 (v c) \<le> \<one>" "v c \<le> n" "DBM_val_bounded v u M n"
  shows "u c \<ge> 0"
proof -
  from assms have "dbm_entry_val u None (Some c) (M 0 (v c))" unfolding DBM_val_bounded_def by auto
  with assms(1) show ?thesis
  proof (cases "M 0 (v c)", goal_cases)
    case 1
    then show ?case unfolding less_eq neutral using order_trans by (fastforce dest!: le_dbm_le)
  next
    case 2
    then show ?case unfolding less_eq neutral
    by (auto dest!: lt_dbm_le) (meson less_trans neg_0_less_iff_less not_less)
  next
    case 3
    then show ?case unfolding neutral less_eq dbm_le_def by auto
  qed
qed

lemma valid_dbm_pos:
  assumes "valid_dbm M n"
  shows "[M]\<^bsub>v,n\<^esub> \<subseteq> {u. \<forall> c. v c \<le> n \<longrightarrow> u c \<ge> 0}"
using dbm_positive assms unfolding valid_dbm_def unfolding DBM_zone_repr_def by fast

lemma (in Regions') V_alt_def:
  shows "{u. \<forall> c. v c > 0 \<and> v c \<le> n \<longrightarrow> u c \<ge> 0} = V"
unfolding V_def using clock_numbering by metis

text \<open>
  An example of obtaining concrete models from our formalizations.
\<close>
lemma steps_z_norm_sound_spec:
  assumes "finite_ta A"
  obtains k v n where
  "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^bsub>k,v,n\<^esub>* \<langle>l',D'\<rangle> \<and> valid_dbm D n \<and> [D']\<^bsub>v,n\<^esub> \<noteq> {}
  \<longrightarrow> (\<exists>Z. A \<turnstile> \<langle>l, [D]\<^bsub>v,n\<^esub>\<rangle> \<leadsto>* \<langle>l',Z\<rangle> \<and> Z \<noteq> {})"
proof -
  from finite_ta_RegionsD[OF assms(1)] obtain k :: "'b \<Rightarrow> nat" and v n x where *:
    "Regions' (clk_set A) v n x" "valid_abstraction A (clk_set A) k" "global_clock_numbering A v n"
  .
  from this(1) interpret interp: Regions' "clk_set A" k v n x .
  define v' where "v' i = (if i \<le> n then (THE c. c \<in> clk_set A \<and> v c = i) else x)" for i
  { fix l D l' D'
    assume step: "A \<turnstile> \<langle>l,D\<rangle> \<leadsto>\<^bsub>(k o v'),v,n\<^esub>* \<langle>l',D'\<rangle>"
    and valid: "valid_dbm D n" and non_empty: "[D']\<^bsub>v,n\<^esub> \<noteq> {}"
    from valid_dbm_pos[OF valid] interp.V_alt_def have "[D]\<^bsub>v,n\<^esub> \<subseteq> interp.V" by blast
    with valid have valid: "interp.valid_dbm D" unfolding valid_dbm_def by auto
    from step have "interp.steps_z_norm' A l D l' D'" unfolding v'_def interp.beta_interp.v'_def .
    note this = interp.steps_z_norm_sound'[OF this *(3,2) valid non_empty]
  }
  then show thesis by (blast intro: that)
qed

end