Theory Energy

(* License: LGPL *)

section ‹Expressiveness Prices›

theory Energy
  imports "HOL-Library.Extended_Nat"
begin

text ‹
  We intend to work on eight-dimensional vectors in an energy game.
  The dimensions will encode expressiveness prices to HML$_\text{SRBB}$ formulas.
  This price is supposed to capture syntactic features needed to describe a certain property and will later be used to select sublogics of specific expressiveness to characterize behavioural equivalences.

  The eight dimensions are intended to measure the following properties of formulas:

    Modal depth (of observations $\langle\alpha\rangle$, $(\alpha)$),
    Depth of branching conjunctions (with one observation clause not starting with $\langle\varepsilon\rangle$),
    Depth of stable conjunctions (that do enforce stability by a $\neg\langle\tau\rangle\top$-conjunct),
    Depth of unstable conjunctions (that do not enforce stability by a $\neg\langle\tau\rangle\top$-conjunct),
    Depth of immediate conjunctions (that are not preceded by $\langle\varepsilon\rangle$),
    Maximal modal depth of positive clauses in conjunctions,
    Maximal modal depth of negative clauses in conjunctions,
    Depth of negations
›

datatype energy =
  E (modal_depth: enat) (br_conj_depth: enat) (conj_depth: enat)
    (st_conj_depth: enat) (imm_conj_depth: enat)
    (pos_conjuncts: enat) (neg_conjuncts: enat) (neg_depth: enat)

subsection ‹Comparing and Subtracting Energies›

text ‹In order to define subtraction on energies, we first lift the orderings
      ≤› and <› from typeenat to typeenergy.›
instantiation energy :: order begin

definition e1  e2 
  (case e1 of E a1 b1 c1 d1 e1 f1 g1 h1  (
    case e2 of E a2 b2 c2 d2 e2 f2 g2 h2 
      (a1  a2  b1  b2  c1  c2  d1  d2  e1  e2  f1  f2  g1  g2  h1  h2)
    ))

definition (x::energy) < y = (x  y  ¬ y  x)

instance proof
  fix e1 e2 e3 :: energy
  show e1  e1 unfolding less_eq_energy_def by (simp add: energy.case_eq_if)
  show e1  e2  e2  e3  e1  e3 unfolding less_eq_energy_def
    by (smt (z3) energy.case_eq_if order_trans)
  show e1 < e2 = (e1  e2  ¬ e2  e1) using less_energy_def .
  show e1  e2  e2  e1  e1 = e2 unfolding less_eq_energy_def
    by (smt (z3) energy.case_eq_if energy.expand nle_le)
qed

lemma leq_components[simp]:
  shows e1  e2 
      (modal_depth e1  modal_depth e2  br_conj_depth e1  br_conj_depth e2
       conj_depth e1  conj_depth e2  st_conj_depth e1  st_conj_depth e2
       imm_conj_depth e1  imm_conj_depth e2  pos_conjuncts e1  pos_conjuncts e2
       neg_conjuncts e1  neg_conjuncts e2  neg_depth e1  neg_depth e2)
  unfolding less_eq_energy_def by (simp add: energy.case_eq_if)

lemma energy_leq_cases:
  assumes
    modal_depth e1  modal_depth e2 br_conj_depth e1  br_conj_depth e2
    conj_depth e1  conj_depth e2 st_conj_depth e1  st_conj_depth e2
    imm_conj_depth e1  imm_conj_depth e2 pos_conjuncts e1  pos_conjuncts e2
    neg_conjuncts e1  neg_conjuncts e2 neg_depth e1  neg_depth e2
  shows
    e1  e2
  using assms unfolding leq_components by blast

end

abbreviation somewhere_larger where somewhere_larger e1 e2  ¬(e1  e2)

lemma somewhere_larger_eq:
  assumes
    somewhere_larger e1 e2
  shows
    modal_depth e1 < modal_depth e2  br_conj_depth e1 < br_conj_depth e2
     conj_depth e1 < conj_depth e2  st_conj_depth e1 < st_conj_depth e2
     imm_conj_depth e1 < imm_conj_depth e2  pos_conjuncts e1 < pos_conjuncts e2
     neg_conjuncts e1 < neg_conjuncts e2  neg_depth e1 < neg_depth e2
  by (smt (z3) assms energy.case_eq_if less_eq_energy_def linorder_le_less_linear)

instantiation energy :: minus
begin

definition minus_energy_def[simp]: e1 - e2  E
  ((modal_depth e1) - (modal_depth e2))
  ((br_conj_depth e1) - (br_conj_depth e2))
  ((conj_depth e1) - (conj_depth e2))
  ((st_conj_depth e1) - (st_conj_depth e2))
  ((imm_conj_depth e1) - (imm_conj_depth e2))
  ((pos_conjuncts e1) - (pos_conjuncts e2))
  ((neg_conjuncts e1) - (neg_conjuncts e2))
  ((neg_depth e1) - (neg_depth e2))

instance ..

end

text ‹Some lemmas to ease the manipulation of expressions using subtraction on energies.›
lemma energy_minus[simp]:
  shows E a1 b1 c1 d1 e1 f1 g1 h1 - E a2 b2 c2 d2 e2 f2 g2 h2
         = E (a1 - a2) (b1 - b2) (c1 - c2) (d1 - d2)
             (e1 - e2) (f1 - f2) (g1 - g2) (h1 - h2)
  unfolding minus_energy_def somewhere_larger_eq by simp

lemma minus_component_leq:
  assumes
    s  x
    x  y
  shows
    modal_depth (x - s)  modal_depth (y - s)
    br_conj_depth (x - s)  br_conj_depth (y - s)
    conj_depth (x - s)  conj_depth (y - s)
    st_conj_depth (x - s)  st_conj_depth (y - s)
    imm_conj_depth (x - s)  imm_conj_depth (y - s)
    pos_conjuncts (x - s)  pos_conjuncts (y - s)
    neg_conjuncts (x - s)  neg_conjuncts (y - s)
    neg_depth (x - s)  neg_depth (y - s)
  using assms by (simp_all) (metis add.commute add_diff_assoc_enat le_iff_add)+

lemma enat_diff_mono:
  assumes (i::enat)  j
  shows i - k  j - k
proof (cases i)
  case (enat iN)
  show ?thesis
  proof (cases j)
    case (enat jN)
    then show ?thesis
      using assms enat_ile by (cases k, fastforce+)
  next
    case infinity
    then show ?thesis using assms by auto
  qed
next
  case infinity
  hence j = 
    using assms by auto
  then show ?thesis by auto
qed

text ‹We further show that the subtraction of energies is decreasing.›
lemma energy_diff_mono:
  fixes s :: energy
  shows mono_on UNIV (λx. x - s)
  unfolding mono_on_def
  by (auto simp add: enat_diff_mono)

lemma gets_smaller:
  fixes s :: energy
  shows (λx. x - s) x  x
  by (auto)
     (metis add.commute add_diff_cancel_enat enat_diff_mono idiff_infinity idiff_infinity_right
      le_iff_add not_infinity_eq zero_le)+

lemma mono_subtract:
  assumes x  x'
  shows (λx. x - (E a b c d e f g h)) x  (λx. x - (E a b c d e f g h)) x'
  using assms enat_diff_mono by force

text ‹Abbreviations for performing subtraction in the energy games.›
abbreviation subtract_fn a b c d e f g h 
  (λx. if somewhere_larger x (E a b c d e f g h) then None else Some (x - (E a b c d e f g h)))

abbreviation subtract a b c d e f g h  Some (subtract_fn a b c d e f g h)

subsection ‹Minimum Updates›
text ‹Two energy updates that replace the first component with the minimum of two other components.›
definition min1_6 e  case e of E a b c d e f g h  Some (E (min a f) b c d e f g h)
definition min1_7 e  case e of E a b c d e f g h  Some (E (min a g) b c d e f g h)

text ‹Abbreviations for identity update.›
abbreviation id_up  Some Some

text ‹lift order to options›
instantiation option :: (order) order
begin

definition less_eq_option_def[simp]:
  less_eq_option (optA :: 'a option) optB 
    case optA of
      (Some a) 
        (case optB of
          (Some b)  a  b |
          None  False) |
      None  True

definition less_option_def[simp]:
  less_option (optA :: 'a option) optB  (optA  optB  ¬ optB  optA)

instance proof standard
  fix x y::'a option
  show (x < y) = (x  y  ¬ y  x) by simp
next
  fix x::'a option
  show x  x
    by (simp add: option.case_eq_if)
next
  fix x y z::'a option
  assume x  y y  z
  thus x  z
    unfolding less_eq_option_def
    by (metis option.case_eq_if order_trans)
next
  fix x y::'a option
  assume x  y y  x
  thus x = y
    unfolding less_eq_option_def
    by (smt (z3) inf.absorb_iff2 le_boolD option.case_eq_if option.split_sel order_antisym)
qed

end

text ‹Again, we prove some lemmas to ease the manipulation of expressions using mininum updates.›

lemma min_1_6_simps[simp]:
  shows modal_depth (the (min1_6 e)) = min (modal_depth e) (pos_conjuncts e)
        br_conj_depth (the (min1_6 e)) = br_conj_depth e
        conj_depth (the (min1_6 e)) = conj_depth e
        st_conj_depth (the (min1_6 e)) = st_conj_depth e
        imm_conj_depth (the (min1_6 e)) = imm_conj_depth e
        pos_conjuncts (the (min1_6 e)) = pos_conjuncts e
        neg_conjuncts (the (min1_6 e)) = neg_conjuncts e
        neg_depth (the (min1_6 e)) = neg_depth e
  unfolding min1_6_def by (simp_all add: energy.case_eq_if)

lemma min_1_7_simps[simp]:
  shows modal_depth (the (min1_7 e)) = min (modal_depth e) (neg_conjuncts e)
        br_conj_depth (the (min1_7 e)) = br_conj_depth e
        conj_depth (the (min1_7 e)) = conj_depth e
        st_conj_depth (the (min1_7 e)) = st_conj_depth e
        imm_conj_depth (the (min1_7 e)) = imm_conj_depth e
        pos_conjuncts (the (min1_7 e)) = pos_conjuncts e
        neg_conjuncts (the (min1_7 e)) = neg_conjuncts e
        neg_depth (the (min1_7 e)) = neg_depth e
  unfolding min1_7_def by (simp_all add: energy.case_eq_if)

lemma min_1_6_some:
  shows min1_6 e  None
  unfolding min1_6_def
  using energy.case_eq_if by blast

lemma min_1_7_some:
  shows min1_7 e  None
  unfolding min1_7_def
  using energy.case_eq_if by blast

lemma min_1_7_lower_end:
  assumes (Option.bind ((subtract_fn 0 0 0 0 0 0 0 1) e) min1_7) = None
  shows neg_depth e = 0
  using assms
  by (smt (verit, ccfv_threshold) bind.bind_lunit energy.sel ileI1
      leq_components min_1_7_some not_gr_zero one_eSuc zero_le)

lemma min_1_7_subtr_simp:
  shows (Option.bind ((subtract_fn 0 0 0 0 0 0 0 1) e) min1_7)
    = (if neg_depth e = 0 then None
        else Some (E (min (modal_depth e) (neg_conjuncts e)) (br_conj_depth e) (conj_depth e)
                     (st_conj_depth e) (imm_conj_depth e) (pos_conjuncts e)
                     (neg_conjuncts e) (neg_depth e - 1)))
  using min_1_7_lower_end
  by (auto simp add: min1_7_def)

lemma min_1_7_subtr_mono:
  shows mono (λe. Option.bind ((subtract_fn 0 0 0 0 0 0 0 1) e) min1_7)
proof
  fix e1 e2 :: energy
  assume e1  e2
  thus (λe. Option.bind ((subtract_fn 0 0 0 0 0 0 0 1) e) min1_7) e1
      (λe. Option.bind ((subtract_fn 0 0 0 0 0 0 0 1) e) min1_7) e2
    unfolding min_1_7_subtr_simp
    by (auto simp add: min.coboundedI1  min.coboundedI2 enat_diff_mono)
qed

lemma min_1_6_subtr_simp:
  shows (Option.bind ((subtract_fn 0 1 1 0 0 0 0 0) e) min1_6)
    = (if br_conj_depth e = 0  conj_depth e = 0 then None
        else Some (E (min (modal_depth e) (pos_conjuncts e)) (br_conj_depth e - 1)
                     (conj_depth e - 1) (st_conj_depth e) (imm_conj_depth e)
                     (pos_conjuncts e) (neg_conjuncts e) (neg_depth e)))
  by (auto simp add: min1_6_def ileI1 one_eSuc)

instantiation energy :: Sup
begin

definition Sup ee  E
  (Sup (modal_depth ` ee)) (Sup (br_conj_depth ` ee )) (Sup (conj_depth ` ee))
  (Sup (st_conj_depth ` ee)) (Sup (imm_conj_depth ` ee)) (Sup (pos_conjuncts ` ee))
  (Sup (neg_conjuncts ` ee)) (Sup (neg_depth ` ee))

instance ..
end


end